perm filename IOSER.TNX[10X,AIL]5 blob
sn#145757 filedate 1975-02-17 generic text, type T, neo UTF8
00100 TENX<;THE ENTIRE FILE IS FOR TENEX ONLY
00200 COMMENT ⊗ TENEX-IOSER -- R. SMITH ⊗
00300 LSTON (IOSER)
00400
00500
00600 IFN ALWAYS, <BEGIN IOSER>
00700
00800 COMMENT ⊗ INDICES, BITS FOR TENEX VERSION OF IOSER ⊗
00900
01000
01100 ;WORDS IN CDB BLOCK FOR EACH CHANNEL
01200
01300
01400 ?GFL←←0 ;FLAGS FOR GTJFN
01500 ?OFL←←1 ;FLAGS FOR OPENF
01600 ?BRCHAR←←2 ;BRCHAR ADDRESS
01700 ?ICOUNT←←3 ;COUNT ADDRESS
01800 ?ENDFL←←4 ;EOF ADDRESS
01900 ?IOCNT←←5 ;I/O COUNT
02000 ?IOBP←←6 ;I/O BP
02100 ?IOSTT←←7 ;STATUS OF THE IO (SEE FLAGS BELOW)
02200 ?IOADDR←←10 ;ADDRESS OF THE IO BUFFER IF THERE IS ONE
02300 ?DVTYP←←11 ;DEVICE TYPE
02400 ?DVDSG←←12 ;DEVICE DESIGNATOR
02500 ?OPNDUN←←13 ;TRUE IF OPENED WITH THE OPEN STATEMENT
02600 ?DVCH←←14 ;DEVICE CHARACTERISTICS
02700 ?DMPED←←15 ;TRUE IF DUMP MODE OUTPUT SEEN
02800 ;IN PARTICULAR USED TO NOTE IF A MAGTAPE
02900 ;HAS BEEN WRITTEN BUT NOT YET CLOSED,
03000 ;SINCE EOF'S ARE WRITTEN AT THE CLOSE
03100 ;BY CLOSF,CFILE,CLOSE,ETC.
03200 ?LINNUM←←16 ;LINE NO (FOR INPUT FUNCTION)
03300 ?PAGNUM←←17 ;PAGE NO (FOR INPUT FUNCTION)
03400 ?SOSNUM←←20 ;SOS LINE NO (FOR INPUT FUNCTION)
03500 ?FKPAGE←←21 ;XWD FORK,PAGE FOR PMAPPING TO DSK
03600 ?IOPAGE←←22 ;PAGE OF THE FILE (IF PMAPPED)
03700 ?FDBSZ←←23 ;BYTE SIZE OF FILE AS IN FDB
03800 ?FDBEOF←←24 ;NO. OF BYTES TO EOF AS IN FDB
03900
04000 ;ADDITIONS TO CDB NUMBERS SHOULD INCLUDE CHANGE TO IOTLEN BELOW
04100
04200 ?IOTLEN←←25 ;CURRENT LENGTH OF CDB BLOCK
04300
00100 DSCR IOSTT(CDB) values.
00200 The following numbers can be in IOSTT(CDB). They indicate
00300 the current state of the IO for the associated channel.
00400 These numbers are set up by SETIO, which is called by
00500 the first IO that happens on the channel. Each routine has
00600 a dispatch table, usually called TABL, and the SIMIO macro
00700 does an XCT on those tables.
00800 ⊗
00900
01000 ?XNULL←←0 ;NOTHING HAPPENING YET
01100 ?XICHAR←←1 ;PMAPPING INPUT CHARS
01200 ?XOCHAR←←2 ;PMAPPING OUTPUT CHARS
01300 ?XIWORD←←3 ;PMAPPING INPUT WORDS
01400 ?XOWORD←←4 ;PMAPPING OUTPUT WORDS
01500 ?XCICHAR←←5 ;36 BIT BUFFERING, INPUT CHARS
01600 ?XCOCHAR←←6 ;36 BIT BUFFERING, OUTPUT CHARS
01700 ?XCIWORD←←7 ;36 BIT BUFFERING, INPUT OR OUTPUT WORDS
01800 ?XBYTE7←←10 ;7 BIT BIN, SIN ETC
01900 ?XDICHAR←←11 ;DUMP MODE CHARACTER INPUT
02000 ?XDOCHAR←←12 ;DUMP MODE CHARACTER OUTPUT
02100 ?XDARR←←13 ;DUMP MORE ARRAY INPUT OR OUTPUT
02200
02300 DEFINE SIMIO(AC,TABL,ERR) <
02400 SKIPGE AC,IOSTT(CDB)
02500 JRST [PUSHJ P,OPNCHK
02600 MOVE AC,IOSTT(CDB)
02700 JRST .+1]
02800 CAILE AC,13 ;MAXIMUM THAT IOSTT CAN BE
02900 JRST ERR
03000 XCT TABL(AC)
03100 >;SIMIO
03200
03300 DEFINE CHKDECCLZ <
03400 SKIPGE IOSTT(CDB)
03500 PUSHJ P,OPNCHK
03600 >;CHKDECCLZ
03700
03800 DEFINE SETZEOF <
03900 SETZM .SKIP.
04000 SKIPE ENDFL(CDB)
04100 SETZM @ENDFL(CDB)
04200 >;SETZEOF
04300
04400 DEFINE SETOEOF <
04500 SETOM .SKIP.
04600 SKIPE ENDFL(CDB)
04700 SETOM @ENDFL(CDB)
04800 >;SETOEOF
04900
05000
00100
00200 IFNDEF JFNSIZE, <?JFNSIZE←←20> ;NUMBER OF CHANNELS ALLOWED
00300 ?DMOCNT←←200 ;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
00400 IFNDEF STARTPAGE,<?STARTPAGE←←610 ;STARTING PAGE FOR BUFFERS>
00500
00600 ;BITS FOR SCAN FLAGS FOR OPENFILE ROUTINE
00700 ;THE BITS OF THE FLAGS WORD ARE THE SAME AS THE BITS OF GTJFN AND OPENF
00800 ;HOPEFULLY (WHERE APPLICABLE)
00900
01000 ?STARBIT←←1B11 ;B11 OF GTJFN FOR INDEXED FILES
01100 ?TEMBIT←←1B5 ;B5 OF GTJFN FOR TEMPORARY FILE
01200 ?DELBIT←←1B8 ;GTJFN -- IGNORE DELETED BIT
01300 ?RDBIT←←1B19 ;B19 OF OPENF FOR READING
01400 ?WRBIT←←1B20 ;B20 OF OPENF FOR WRITING
01500 ?APPBIT←←1B22 ;B22 OF OPENF FOR APPEND
01600 ?CONFB1←←1B3 ;GTJFN BIT TO PRINT [CONFIRM] ETC
01700 ?CONFB2←←1B4 ;GTJFN BIT TO REQUIRE CONFIRMATION FROM USER
01800 ;ODDLY ENOUGH 3 AND 4 ARE ILLEGAL
01900 ?OUTBIT←←1B0 ;GTJFN -- FILE FOR OUTPUT USE
02000 ?OLDBIT←←1B2 ;GTJFN -- OLD FILE
02100 ?NEWBIT←←1B1 ;GTJFN -- NEW FILE
02200 ?ERTNBIT←←1B27 ;ERROR RETURN BIT -- INTERNAL
02300 ?BINBIT←←1B26 ;BINARY BIT -- INTERNAL
02400 ?THAWBIT←←1B25 ;THAWBIT GTJFN
02500 ?ERSNBIT←←1B28 ;ERROR SEEN -- INTERNAL
02600 ?CONFBIT←←1B29 ;CONFIRMATION -- INTERNAL
02700
02800 ;MACROS FOR BIT TESTING
02900
03000 DEFINE .ZZZ $ (X,Y,Z)<
03100 IFN Z&777777000000, <TL$X Y,Z⊗-=18> ;Z LSH -=18
03200 IFN Z&777777, <TR$X Y,Z>
03300 >
03400
03500 DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z> ;TDNE Y,[Z]
03600 DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z> ;TDNN Y,[Z]
03700 DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z> ;TDO Y,[Z]
03800 DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W> ;TDZ Y,[Z]
03900
04000
04100 ;MACRO TO GET THE JFN NUMBER IN X FROM Y. IF INVALID, JUMP TO LABEL Z
04200 ;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
04300 ;LOADS CHNL WITH THE CHANNEL NUMBER
04400 DEFINE VALCHN(X,Y,Z) <
04500
04600 SKIPL CHNL,Y
04700 CAIL CHNL,JFNSIZE
04800 JRST Z
04900 MOVE CDB,CDBTBL(CHNL)
05000 HRRZ X,JFNTBL(CHNL)
05100 JUMPE X,Z
05200 >;VALCHN
05300
05400 DEFINE LITCHN(X,Y,Z) <
05500 SKIPL X,Y
05600 CAIL X,JFNSIZE
05700 JRST Z
05800 MOVEM X,CHNL
05900 MOVE CDB,CDBTBL(CHNL)
06000 HRRZ X,JFNTBL(CHNL)
06100 >;LITCHN
06200
06300 ;ONLY USES AC X
06400 DEFINE VALCH1(X,Y,Z) <
06500 SKIPL X,Y
06600 CAIL X,JFNSIZE
06700 JRST Z
06800 HRRZ X,JFNTBL(X)
06900 JUMPE X,Z
07000 >
07100
07200 ;TTY STUFF
07300 ;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
07400 IFNDEF DELLINE,<?DELLINE←←"U"-100> ;CTRL-U
07500 IFNDEF RUBCHAR,<?RUBCHAR←←177> ;RUBOUT
07600 ?ALTMODE←←175 ;ONE OF MANY VERSIONS OF ALTMODE
07700
07800
00100 COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
00200 ,<SAVE,RESTR,RELEASE,CORGET,INSET>
00300 ,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)
00400
00500 BEGIN PAT
00600
00700 DSCR PROCEDURE OPEN(INTEGER CHAN; STRING DEV; INTEGER MODE,IBUF,OBUF;
00800 REFERENCE INTEGER COUNT,BR,EOF)
00900 ⊗
01000 HERE(OPEN)
01100 BEGIN OPEN
01200 GTFLAGS←←4
01300 OPFLAGS←←5
01400 PUSH P,-7(P)
01500 PUSH P,[0] ;CLOSE INHIBIT
01600 PUSHJ P,RELEASE ;RELEASE IF ALREADY OPEN
01700
01800 ;SEE WHAT KIND OF DEVICE WE HAVE
01900
02000 PUSH SP,-1(SP)
02100 PUSH SP,-1(SP)
02200 PUSH P,[0]
02300 PUSHJ P,CATCHR ;PUT ON A NULL CHAR
02400 PUSHJ P,MAKUP ;MAKE UPPER CASE (DAMMIT)
02500 PUSH SP,-3(SP)
02600 PUSH SP,-3(SP)
02700 PUSH SP,[3]
02800 PUSH SP,[POINT 7,[ASCIZ/:
02900 /]]
03000 PUSHJ P,CAT ;PUT ON A STRING
03100 POP SP,-4(SP)
03200 POP SP,-4(SP) ;SAVE ABOVE
03300
03400 PUSHJ P,SAVE ;NOW SAVE ACS
03500 SETZ LPSA, ;NO PARAMETERS TO REMOVE
03600 MOVE CHNL,-7(P) ;USER CHANNEL NUMBER
03700 MOVE 1,(SP) ;STRING FOR DEVICE
03800 SUB SP,X22 ;ADJUST STACK
03900 JSYS STDEV
04000 JRST BADOPN ;NOT A PLAUSIBLE DEVICE
04100 PUSH P,2 ;SAVE DEVICE DESIGNATOR
04200 ;ITS A PLAUSIBLE DEVICE
04300 MOVEI C,IOTLEN
04400 PUSHJ P,CORGET
04500 ERR <OPEN: CANNOT GET CORE>
04600 MOVE CDB,B ;IO BLOCK ADDRESS
04700 MOVEM CDB,CDBTBL(CHNL) ;SAVE
04800 ;ZERO OUT CORE (SINCE CORGET DOESNT!!!)
04900 HRL B,B
05000 ADDI B,1
05100 SETZM (CDB)
05200 BLT B,IOTLEN-1(CDB)
05300
05400 POP P,1 ;GET DEVICE DESIGNATOR
05500 MOVEM 1,DVDSG(CDB) ;AND SAVE IT
05600 JSYS DVCHR
05700 MOVEM 2,DVCH(CDB) ;SAVE DEVICE CHARACTERISTICS
05800 HLRZ 1,2
05900 ANDI 1,777 ;DEVICE TYPE
06000 MOVEM 1,DVTYP(CDB) ;SAVE IT
06100 MOVEI 2,STARTPAGE(CHNL) ;PAGE BUFFERING
06200 HRLI 2,400000 ;XWD FORK,PAGE
06300 MOVEM 2,FKPAGE(CDB)
06400 LSH 2,9 ;ADDRESS
06500 MOVEM 2,IOADDR(CDB)
06600 SETOM IOPAGE(CDB) ;AT (MYTHICAL) PAGE -1
06700 MOVE 2,DVCH(CDB) ;DEVICE CHARS
06800 TLNN 2,100000 ;IS DEVICE A DIRECTORY DEVICE
06900 JRST GTNOW ;NOPE, DO GTJFN AND OPENF NO
07000 HASDIR:
07100 ;GET THE MODE IN 4
07200 MOVE 4,-6(P) ;MODE
07300 ANDI 4,17 ;FORGET OTHER JUNK
07400 ;IF DEVICE IS A DECTAPE IN DUMP MODE THEN DO IT NOW ALSO
07500 CAIE 1,3 ;IS IT A DECTAPE?
07600 JRST HASDI1 ;NO
07700 CAIN 4,17 ;IN DUMP MODE?
07800 JRST DOMNT ;YES MOUNT AND THEN OPEN
07900 ;SO DONT DO GTJFN NOW, BUT WAIT
08000 HASDI1: SETZM JFNTBL(CHNL) ;BE SURE
08100 MOVEM 4,GFL(CDB) ;SAVE THE MODE AS THE GTJFN FLAGS
08200 HRL 4,-5(P) ;INPUT BUFFERS
08300 HRR 4,-4(P) ;OUTPUT BUFFERS
08400 MOVEM 4,OFL(CDB) ;SAVE AS THE OPENF FLAGS
08500 JRST GUDRET ;AND RETURN
08600
08700 ;MOUNT AND OPEN DECTAPE IN DUMP MODE
08800 DOMNT: MOVE A,DVDSG(CDB) ;GET DEVICE DESIGNATOR
08900 TLO A,(1B3) ;DONT READ DIRECTORY FOR DUMP MODE
09000 JSYS MOUNT
09100 JRST BADOPN ;CANNOT MOUNT
09200 MOVSI GTFLAGS,100001
09300 MOVE 1,GTFLAGS
09400 MOVE 2,(SP)
09500 JSYS GTJFN
09600 JRST BADOPN
09700 MOVEM 1,JFNTBL(CHNL)
09800 MOVEM GTFLAGS,GFL(CDB)
09900 MOVE OPFLAGS,[447400000000!RDBIT!WRBIT]
10000 MOVE 2,OPFLAGS
10100 JSYS OPENF
10200 JRST CNTOPN
10300 JRST OPOK
10400
10500 GTNOW:
10600 MOVSI GTFLAGS,100001
10700 MOVE 1,GTFLAGS
10800 MOVE 2,(SP) ;DEVICE STRING
10900 JSYS GTJFN
11000 JRST BADOPN ;NOPE CANNOT GET
11100 MOVEM 1,JFNTBL(CHNL) ;SAVE JFN
11200 MOVEM GTFLAGS,GFL(CDB) ;AND SAVE THEM
11300 ;COMPUTE OPENF FLAGS
11400 SETZ OPFLAGS,
11500 MOVE 2,DVCH(CDB) ;DEVICE CHARACTERISTICS
11600 TESTE 2,<1B1> ;CAN DO INPUT?
11700 TESTO OPFLAGS,RDBIT
11800 TESTE 2,<1B0> ;CAN DO OUTPUT?
11900 TESTO OPFLAGS,WRBIT
12000 MOVE 1,DVTYP(CDB) ;CHECK DEVICE TYPE
12100 CAIN 1,12 ;IS IT A TTY?
12200 JRST OP7BT ;USE 7 BIT BYTES
12300 ;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
12400
12500 HRRZ 1,JFNTBL(CHNL)
12600 HRLI OPFLAGS,440000
12700 MOVE 2,OPFLAGS ;36-BIT, MODE 0
12800 JSYS OPENF
12900 SKIPA
13000 JRST OPOK
13100 HRRZ 1,JFNTBL(CHNL)
13200 HRLI OPFLAGS,447400 ;36-BIT, MODE 17
13300 MOVE 2,OPFLAGS
13400 JSYS OPENF
13500 SKIPA
13600 JRST OPOK
13700 OP7BT: HRRZ 1,JFNTBL(CHNL)
13800 HRLI OPFLAGS,70000 ;7-BIT, MODE 0
13900 MOVE 2,OPFLAGS
14000 JSYS OPENF
14100 JRST NOOPN
14200 OPOK: MOVEM OPFLAGS,OFL(CDB) ;SAVE OP FLAGS
14300 GUDRET:
14400 ;SAVE FLAGS
14500 SETOM OPNDUN(CDB) ;INDICATE OPENED WITH OPEN
14600 POP P,TEMP ;RETURN ADDRESS
14700 POP P,ENDFL(CDB) ;SAVE GOOD THINGS
14800 POP P,BRCHAR(CDB)
14900 POP P,ICOUNT(CDB)
15000 SETZM @ENDFL(CDB) ;INDICATE GOOD OPENING
15100 SUB SP,X22 ;CLEAN UP STACKS
15200 SUB P,X44
15300 JRST RESTR ;AND RETURN
15400
15500
15600 NOOPN:
15700 CNTOPN: SKIPN 1,JFNTBL(CHNL) ;RELEASE JFN
15800 JSYS RLJFN
15900 JFCL
16000 BADOPN:
16100 SKIPE B,CDBTBL(CHNL) ;CORE ALLOCATED?
16200 PUSHJ P,CORREL ;RELEASE CORE
16300 SETZM JFNTBL(CHNL)
16400 SETZM CDBTBL(CHNL)
16500 SKIPN @-1(P) ;USER WANTS ERROR?
16600 ERR <OPEN: IO ERROR OR ILLEGAL SPECIFICATIONS>,1
16700 SETOM @-1(P)
16800 POP P,TEMP
16900 SUB P,[XWD 7,7]
17000 SUB SP,X22
17100 JRST RESTR
17200
17300
17400
17500
17600 BEND OPEN
17700
17800 ;MAKE UPPER CASE LETTERS
17900 MAKUP: PUSHJ P,SAVE
18000 SKIPE SGLIGN(USER)
18100 PUSHJ P,INSET
18200 HRRZ A,-1(SP) ;LENGTH OF STRING
18300 ADDM A,REMCHR(USER)
18400 SKIPLE REMCHR(USER) ;OK?
18500 PUSHJ P,STRNGC ;NO, COLLECT
18600 MOVE B,A
18700 HRRO A,A
18800 PUSH SP,A
18900 PUSH SP,TOPBYTE(USER)
19000 UPPER1: JUMPLE B,UPPER2 ;DONE YET?
19100 ILDB C,-2(SP) ;NEXT CHAR
19200 CAIL C,141
19300 CAILE C,172
19400 SKIPA
19500 SUBI C,40 ;CONVERT TO UPPER CASE
19600 IDPB C,TOPBYTE(USER)
19700 SOJA B,UPPER1
19800 UPPER2: POP SP,-2(SP)
19900 POP SP,-2(SP)
20000 SETZ LPSA,
20100 POP P,TEMP ;RETURN ADDR
20200 JRST RESTR ;RETURN
20300
00100 DSCR PROCEDURE LOOKUP(INTEGER CHNL; STRING FILE; REFERENCE INTEGER FLAG)
00200
00300 ⊗
00400
00500 HERE(LOOKUP)
00600 BEGIN LOOKUP
00700 PUSHJ P,TENXFI ;MAKE THE FILE SPEC TENEX
00800
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 PUSH P,CHNL
01300 PUSH P,CDB
01400 DEFINE CHNARG <-7(P)>
01500 DEFINE FLGARG <-6(P)>
01600
01700
01800 SKIPL CHNL,CHNARG
01900 CAIL CHNL,JFNSIZE
02000 JRST BADLU1
02100 MOVE CDB,CDBTBL(CHNL)
02200 SKIPN OPNDUN(CDB) ;ERROR IF NOT OPENED
02300 JRST BADLU1
02400 MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
02500 TLNN 2,100000 ;DOES DEVICE HAVE A DIRECTORY?
02600 JRST LUKRET ;NO, NO LOOKUP
02700 SKIPE JFNTBL(CHNL) ;JFN ALREADY ASSIGNED?
02800 PUSHJ P,RELNOW ;YES, RELEASE IT
02900
03000 PUSHJ P,DEVCAT
03100
03200 MOVSI 1,100001 ;OLD FILE
03300 MOVE 2,(SP)
03400 JSYS GTJFN
03500 JRST BADLUK
03600 MOVEM 1,JFNTBL(CHNL)
03700 MOVSI 3,100001
03800 MOVEM 3,GFL(CDB)
03900 MOVE 2,[XWD 440000,200000] ;36-BIT
04000 JSYS OPENF
04100 SKIPA
04200 JRST GUDLUK
04300 MOVE 1,JFNTBL(CHNL)
04400 MOVE 2,[XWD 447400,200000] ;36-BIT, DUMP
04500 JSYS OPENF
04600 SKIPA
04700 JRST GUDLUK
04800 MOVE 1,JFNTBL(CHNL)
04900 MOVE 2,[XWD 70000,200000] ;7-BIT
05000 JSYS OPENF
05100 JRST BADLUK
05200 GUDLUK: MOVEM 2,OFL(CDB)
05300 SETZM @FLGARG
05400 LUKRET: POP P,CDB
05500 POP P,CHNL
05600 POP P,3
05700 POP P,2
05800 POP P,1
05900 SUB SP,X22
06000 SUB P,X33
06100 JRST @3(P)
06200
06300 BADLUK: MOVEM 1,@FLGARG
06400 JRST LUKRET
06500
06600 BADLU1: SETOM @FLGARG
06700 JRST LUKRET
06800
06900
07000 BEND LOOKUP
07100
07200 DEVCAT:
07300 ;HERE WITH CDB LOADED, FILENAME ON THE SP STACK
07400 ;RETURN WITH "DEV:FILE" & 0 ON THE SP STACK
07500 ;MUST NOT HAVE CALLED SAVE WHEN THIS IS CALLED
07600 PUSH P,1
07700 PUSH P,2
07800 PUSH P,[=100]
07900 PUSHJ P,ZSETST ;BP IN 1
08000 MOVE 2,DVDSG(CDB) ;DEVICE DESIGNATOR
08100 JSYS DEVST
08200 ERR <LOOKUP, ENTER, OR RENAME: CANNOT DO DEVST>
08300 PUSH P,[=100]
08400 PUSH P,1 ;UPDATED BP
08500 PUSHJ P,ZADJST
08600 PUSH P,[":"]
08700 PUSHJ P,CATCHR
08800 PUSHJ P,CAT.RV
08900 PUSH P,[0]
09000 PUSHJ P,CATCHR
09100 POP P,2
09200 POP P,1
09300 POPJ P,
09400
09500 ;RELEASE JFN ALREADY THERE
09600 RELNOW:
09700 PUSH P,CHNL ;CHANNEL
09800 PUSHJ P,CLOSF ;CLOSE DANCE
09900 PUSH P,1
10000 MOVE 1,JFNTBL(CHNL) ;GET JFN
10100 JSYS RLJFN ;RELEASE
10200 ERR <CANNOT RELEASE JFN>,1
10300 SETZM JFNTBL(CHNL) ;AND ZERO OUT
10400 SETZM IOSTT(CDB) ;NO STATUS
10500 POP P,1
10600 POPJ P,
10700
10800
00100 HERE(ENTER)
00200 BEGIN ENTER
00300
00400 PUSHJ P,TENXFI
00500
00600 PUSH P,1
00700 PUSH P,2
00800 PUSH P,3
00900 PUSH P,CHNL
01000 PUSH P,CDB
01100 DEFINE CHNARG <-7(P)>
01200 DEFINE FLGARG <-6(P)>
01300
01400 SKIPL CHNL,CHNARG
01500 CAIL CHNL,JFNSIZE
01600 JRST BADEN1
01700 MOVE CDB,CDBTBL(CHNL)
01800 SKIPN OPNDUN(CDB)
01900 JRST BADEN1 ;WAS AN OPEN PERFORMED HERE?
02000 SKIPN 1,JFNTBL(CHNL)
02100 JRST NOTOPN
02200 MOVE 2,DVCH(CDB) ;GET DEVICE CHARACTERISTICS
02300 TLNN 2,100000 ;DOES DEVICE HAVE DIRECTORY?
02400 JRST ENTRET ;NO
02500
02600 SKIPGE IOSTT(CDB) ;A DEC-STYLE CLOSE DONE? CHKDECCLZ
02700 JRST [PUSHJ P,RELNOW ;RELEASE JFN
02800 JRST NOTOPN ;AND PROCEED
02900 ]
03000
03100 PUSH P,1 ;SAVE JFN
03200 SETO 1, ;UNMAP THE BUFFER PAGE
03300 MOVE 2,FKPAGE(CDB)
03400 SETZ 3,
03500 JSYS PMAP ;REMOVE PAGE
03600 POP P,1
03700
03800 SETOM IOPAGE(CDB)
03900 SETZM IOSTT(CDB)
04000
04100 PUSH P,1 ;SAVE JFN
04200 TLO 1,400000 ;DO NOT RELEASE THE JFN
04300 JSYS CLOSF
04400 JFCL ;IGNORE
04500 POP P,1
04600 MOVE 2,OFL(CDB)
04700 TESTO 2,WRBIT ;TURN ON WRITE BIT
04800 MOVEM 2,OFL(CDB) ;AND SAVE NEW FLAGS
04900 JSYS OPENF
05000 JRST BADENT ;ERROR IN 1
05100 JRST ENTRET ;RETURN
05200
05300 NOTOPN:
05400 PUSHJ P,DEVCAT
05500
05600 MOVSI 1,600001 ;NEW FILE
05700 MOVE 2,(SP)
05800 JSYS GTJFN
05900 JRST BADENT ;CANNOT GTJFN
06000 MOVEM 1,JFNTBL(CHNL)
06100 MOVSI 2,600001 ;THE
06200 MOVEM 2,GFL(CDB) ;SAVE THE GTJFN FLAGS
06300 B36: HRRZ 1,JFNTBL(CHNL)
06400 MOVE 2,[XWD 440000,100000] ;36-BIT
06500 JSYS OPENF
06600 SKIPA
06700 JRST ENT1
06800 HRRZ 1,JFNTBL(CHNL)
06900 MOVE 2,[XWD 447400,100000] ;36-BIT, DUMP
07000 JSYS OPENF
07100 SKIPA
07200 JRST ENT1
07300 HRRZ 1,JFNTBL(CHNL)
07400 MOVE 2,[XWD 70000,100000]
07500 JSYS OPENF
07600 JRST BADENT
07700 ENT1: MOVEM 2,OFL(CDB)
07800 ENTRET: SETZM @FLGARG
07900 ENTPOP: POP P,CDB
08000 POP P,CHNL
08100 POP P,3
08200 POP P,2
08300 POP P,1
08400 SUB SP,X22
08500 SUB P,X33
08600 JRST @3(P)
08700
08800
08900 BADENT: MOVEM 1,@FLGARG
09000 JRST ENTPOP
09100
09200 BADEN1: SETOM @FLGARG
09300 JRST ENTPOP
09400
09500 BEND ENTER
09600
00100 DSCR
00200 RENAME(CHNL,"STR",PROT,@FLAG)
00300 Since protection is not implemented in TENEX,
00400 the feature will be ignored.
00500 ⊗
00600
00700 HERE(RENAME)
00800 BEGIN RENAME
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 PUSH P,CHNL
01300 PUSH P,CDB
01400 DEFINE CHNARG <-10(p)>
01500 DEFINE FLGARG <-6(P)>
01600
01700 VALCHN 1,CHNARG,RENBAD
01800 PUSHJ P,OPNCHK ;MAKE SURE OPEN (SOMEWHAT REDUNDANT)
01900 MOVE 2,DVCH(CDB) ;DEVICE CHARS
02000 TLNN 2,100000 ;DIRECTORY DEVICE?
02100 JRST RENRET ;NO, NOP
02200
02300 PUSHJ P,TENXFI ;MAKE A TENEX FILE NAME
02400
02500 ;PERHAPS ONLY A DELETE?
02600 HRRZ 2,-1(SP) ;NULL FILE SPEC?
02700 JUMPE 2,RENDEL ;YES, DELETE
02800
02900 ;ACTUALLY RENAME (ON THE SAME DEVICE)
03000 PUSH P,CHNARG
03100 PUSHJ P,CLOSF ;FIRST CLOSE THE FILE
03200
03300 PUSHJ P,DEVCAT
03400
03500 MOVE 3,1 ;SAVE FIRST JFN
03600 MOVE 1,GFL(CDB) ;USE SAME FLAGS
03700 TESTZ 1,OLDBIT ;EXCEPT NOT OLD
03800 TESTO 1,NEWBIT ;BUT DO WANT NEW
03900 TESTO 1,OUTBIT ;AND VERSION DEFAULTING
04000 MOVEM 1,GFL(CDB) ;SAVE FLAGS
04100 MOVE 2,(SP)
04200 JSYS GTJFN
04300 JRST RENERR ;ERROR BITS IN 1
04400
04500 MOVE 2,1 ;NEW JFN
04600 MOVE 1,3 ;OLD JFN
04700 JSYS RNAMF
04800 JRST RENERR ;ERROR BITS IN 1
04900 MOVE 1,2 ;NEW JFN
05000 MOVE 2,OFL(CDB) ;OPENF FLAGS
05100 JSYS OPENF
05200 JRST RENERR ;ERROR BITS IN 1
05300 MOVEM 1,JFNTBL(CHNL) ;SAVE THE NEW JFN
05400
05500 RENRET: SETZM @FLGARG ;INDICATE A GOOD RETURN
05600 RENRE1: POP P,CDB
05700 POP P,CHNL
05800 POP P,3
05900 POP P,2
06000 POP P,1
06100 SUB SP,X22
06200 SUB P,X44
06300 JRST @4(P)
06400
06500 RENERR: MOVEM 1,@FLGARG
06600 JRST RENRE1
06700
06800 RENBAD: SETOM @FLGARG
06900 JRST RENRE1
07000
07100 RENDEL: JSYS DELF ;JFN IN 1
07200 JRST RENERR
07300 JRST RENRET
07400 BEND RENAME
07500
00100 DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
00200 ⊗
00300
00400 HERE(USETI)
00500 HERE(USETO)
00600 BEGIN USETS
00700
00800 PUSH P,1
00900 PUSH P,2
01000 PUSH P,3
01100 PUSH P,CHNL
01200 SETZM .SKIP.
01300 VALCHN 1,-6(P),USETERR
01400 MOVE 2,DVTYP(CDB)
01500 CAIN 2,3 ;IS IT A DECTAPE
01600 JRST USEDTA
01700 MOVE 2,-5(P) ;ARGUMENT
01800 SOJ 2,
01900 LSH 2,7 ;CONVERT BLOCK TO WORD NUMBER
02000 PUSH P,-6(P) ;CHANNEL ARG
02100 PUSH P,2 ;WORD TO SET TO
02200 PUSHJ P,SWDPTR ;SET THE WORD POINTER
02300 USETRET:POP P,CHNL
02400 POP P,3
02500 POP P,2
02600 POP P,1
02700 SUB P,X33
02800 JRST @3(P)
02900
03000
03100 USEDTA:
03200 MOVEI 2,30 ;OPERATION 30 FOR DECTAPES
03300 HRRZ 3,-5(P) ;TAPE BLOCK
03400 JSYS MTOPR ;SET DIRECTLY
03500 JRST USETRET ;AND RETURN
03600
03700 USETER: ERR<Illegal JFN>,1
03800 SETOM .SKIP.
03900 JRST USETRET ;AND RETURN
04000
04100 BEND USETS
04200
00100 DSCR PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSE_INHIBIT_BITS])
00200 procedure closo(integer chan; integer bits(0))
00300 procedure closin(integer chan; integer bits(0))
00400 ⊗
00500 BEGIN CLOSES
00600
00700 HERE(CLOSIN)
00800 HERE(CLOSO)
00900 PUSH P,-2(P)
01000 PUSHJ P,CLOSF
01100 PUSHJ P,SAVE
01200 VALCHN 1,-2(P),.+2
01300 SETOM IOSTT(CDB) ;MARK AS BEING CLOSED
01400 MOVE LPSA,X33
01500 JRST RESTR
01600
01700 HERE(CLOSE)
01800 DOOPN: PUSH P,-2(P)
01900 PUSHJ P,CLOSF ;FORCE BUFFERS OUT, WRITE MAGT EOFS, CLOSF
02000 PUSHJ P,SAVE
02100 VALCHN 1,-2(P),CLORET
02200 SETOM IOSTT(CDB) ;MARK AS BEING CLOSED
02300 CLORET: MOVE LPSA,X33
02400 JRST RESTR
02500
02600 BEND CLOSES
02700
00100 HERE(RELEASE)
00200 DSCR
00300 Ignores the close inhibit bits that are available in
00400 the STANFORD SAIL, until we decide what to do with them.
00500 ⊗
00600
00700 PUSH P,1
00800 PUSH P,-3(P) ;CHANNEL
00900 PUSHJ P,CFILE
01000 POP P,1 ;RESTORE 1
01100 SUB P,X33
01200 JRST @3(P) ;RETURN
01300
01400
01500
01600
00100 DSCR
00200 PROCEDURE MTAPE(INTEGER CHAN,OPERATION)
00300 (the operation is a character e.g., "U" to unload)
00400 as in the SAIL manual.
00500 ⊗
00600
00700 HERE(MTAPE)
00800 BEGIN MTAPE
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X33
01100 LDB C,[POINT 5,-1(P),35]
01200 MOVE A,OPTAB
01300 MOVE B,OPTAB+1
01400 TRZE C,30 ;COMPRESS TABLE
01500 ADDI C,5
01600 LSH C,2
01700 ROTC A,(C)
01800 ANDI B,17
01900 VALCHN 1,-2(P),MTAERR
02000 PUSHJ P,OPNCHK ;MAKE SURE OPEN
02100 JSYS MTOPR
02200 JRST RESTR
02300 MTAERR: ERR <Illegal JFN>,1
02400 JRST RESTR
02500
02600 OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,E,F,R,S,T
02700 BYTE (4) 11,0,1 ;U,W
02800
02900 BEND MTAPE
03000
03100
03200
03300
00100 DSCR STRING PROCEDURE TENXFI(STRING DECFILE)
00200
00300 Converts the string to a TENEX file specification.
00400 A la Alex Cannara.
00500 ⊗
00600
00700 HERE(TENXFI)
00800 BEGIN TENXFI
00900
01000 CTRLV←←"V"-100
01100 FIND←←2
01200
01300 PUSH P,1
01400 PUSH P,2
01500 PUSH P,3
01600 SETZM FIND
01700 PUSH SP,[0] ;DEVICE TEMPORARY
01800 PUSH SP,[0]
01900 PUSH SP,[0] ;DIR TEMPORARY
02000 PUSH SP,[0]
02100 PUSH SP,[0] ;NAM TEMPORARY
02200 PUSH SP,[0]
02300
02400 DEFINE ORIG <-7(SP)>
02500 DEFINE ORIG1 <-6(SP)>
02600 DEFINE DEV <-5(SP)>
02700 DEFINE DEV1 <-4(SP)>
02800 DEFINE DIR <-3(SP)>
02900 DEFINE DIR1 <-2(SP)>
03000 DEFINE NAM <-1(SP)>
03100 DEFINE NAM1 <0(SP)>
03200
03300 ;SIMPLE SINCE NAME IS AT THE TOP OF SP
03400 DEFINE CATNAM (X) <
03500 PUSH P,X
03600 PUSHJ P,CATCHR
03700 >
03800 DEFINE CATDIR (X) <
03900 PUSH P,X
04000 PUSH SP,DIR
04100 PUSH SP,DIR
04200 PUSHJ P,CATCHR
04300 POP SP,-4(SP)
04400 POP SP,-4(SP)
04500 >
04600
04700 DEFINE GCH <
04800 HRRZ 1,ORIG
04900 JUMPE 1,TENDUN
05000 ILDB 3,ORIG1
05100 SOS ORIG
05200 >
05300
05400
05500 TENX1: GCH
05600 CAIE 3,CTRLV
05700 JRST NOQUOTE
05800 SKIPE FIND
05900 JRST QUODIR
06000 PUSHJ P,CATNA3
06100 GCH
06200 PUSHJ P,CATNA3 ;AND THE CHAR FOLLOWING THE CTRLV
06300 JRST TENX1
06400 QUODIR: PUSHJ P,CATDI3
06500 GCH
06600 PUSHJ P,CATDI3
06700 JRST TENX1 ;AND CONTINUE
06800
06900 NOQUOTE:
07000 CAIN 3,":" ;COLON -- DEVICE
07100 JRST ISDEV ;ITS BEEN A DEVICE ALL ALONG!!
07200 CAIN 3,","
07300 JRST TENX1 ;IGNORE COMMA
07400 CAIE 3,40 ;SPACE
07500 CAIN 3,11 ;OR TAB
07600 JRST TENX1
07700
07800 CAIE 3,"<" ;THESE START THE DIRECTORY NAME
07900 CAIN 3,"["
08000 JRST STDIR
08100 CAIE 3,">" ;THESE FINISH THE DIR. NAME
08200 CAIN 3,"]"
08300 JRST ENDDIR
08400 SKIPE FIND ;DOING DIRECTORY?
08500 JRST .+3 ;YES
08600 PUSHJ P,CATNA3
08700 JRST TENX1
08800 PUSHJ P,CATDI3
08900 JRST TENX1
09000
09100 STDIR: SETOM FIND
09200 SKIPE DIR ;ANYTHING THERE?
09300 JRST TENX1 ;YES, IGNORE
09400 CATDIR <[74]>
09500 JRST TENX1
09600
09700 ENDDIR: SETZM FIND
09800 JRST TENX1
09900
10000 ISDEV: PUSHJ P,CATNA3 ;PUT THE COLON ON THE NAME
10100 MOVE 3,NAM ;THE "NAME" HAS REALLY BEEN A DEV
10200 MOVEM 3,DEV
10300 MOVE 3,NAM1
10400 MOVEM 3,DEV1
10500
10600 SETZM NAM ;SO CLEAR THE NAME -- START OVER
10700 SETZM NAM1
10800 JRST TENX1
10900
11000 TENDUN:
11100 ;CHECK TO SEE WHAT LAST CHAR OF DIR IS
11200 SKIPN DIR
11300 JRST GOTDIR ;NO DIRECTORY THERE
11400 CATDIR <[76]> ;PUT ON A ">"
11500 ;NOW STACK HAS ORIG,DEV,DIR,NAM
11600 GOTDIR:
11700 PUSHJ P,CAT
11800 ;NOW STACK HAS ORIG,DEV,<DIR>NAM
11900 PUSHJ P,CAT
12000 ;NOW STACK HAS ORIG,DEV:<DIR>NAM
12100 GOTDI1: POP SP,-2(SP)
12200 POP SP,-2(SP)
12300
12400 TXFRET:
12500 POP P,3
12600 POP P,2
12700 POP P,1
12800 POPJ P,
12900
13000
13100 ;CALL CAT MACROS WITH AC 3 AS THE ARG
13200 CATNA3: CATNAM 3
13300 POPJ P,
13400
13500 CATDI3: CATDIR 3
13600 POPJ P,
13700
13800
13900 BEND TENXFI
14000
00100 DSCR
00200 INTEGER PROCEDURE GETCHAN(INTEGER I)
00300 RETURNS AN UNUSED CHANNEL NUMBER, AND MARKS IT
00400 FOR USE, SO THAT NO ONE WILL TRY TO USE IT.
00500 ⊗
00600
00700 HERE(GETCHAN)
00800 MOVE A,[XWD -JFNSIZE+1,1] ;START AT CHANNEL 1
00900 GETCH1: SKIPN CDBTBL(A) ;ALLOCATED YET?
01000 JRST GETCH2 ;NO, TAKE IT
01100 AOBJN A,GETCH1 ;YES
01200 SETOM A ;INDICATE ERROR
01300 POPJ P,
01400
01500 GETCH2: HRRZ A,A
01600 PUSH P,B ;NOW ALLOCATE A TABLE
01700 PUSH P,C
01800 MOVEI C,IOTLEN
01900 PUSHJ P,CORGET
02000 ERR <GETCHAN: CANNOT GET CORE>
02100 MOVEM B,CDBTBL(A)
02200
02300 HRL C,B ;ZERO OUT BLOCK
02400 HRRI C,1(B)
02500 SETZM (B)
02600 BLT C,IOTLEN-1(B)
02700
02800 SETZM JFNTBL(A) ;BUT NO JFN (YET)
02900 POP P,C
03000 POP P,B
03100 POPJ P,
03200
03300 DSCR
03400 INTEGER PROCEDURE CVJFN(INTEGER CHAN)
03500
03600 Returns the JFN (XWD flags,jfn) associated
03700 with a logical channel, -1 if no jfn assigned.
03800 Hereby, the user of these routines can access
03900 the system directly if the need arises.
04000 ⊗
04100 HERE(CVJFN)
04200 SKIPL 1,-1(P)
04300 CAIL 1,JFNSIZE
04400 JRST CVJFER
04500 SKIPN 1,JFNTBL(1)
04600 JRST CVJFER
04700 CVJFR: SUB P,X22
04800 JRST @2(P)
04900 CVJFER: SETO 1,
05000 JRST CVJFR
05100
05200
05300 BEND PAT
05400
05500 ENDCOM(PAT)
05600
00100 COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
00200 ,<JOBINF -- JOB UTILITY ROUTINES>)
00300 DSCR STRING SIMPLE PROCEDURE ODTIM(INTEGER DT,FORMAT)
00400 Returns the string representation of DT
00500 (which is in internal TENEX representation). If DT
00600 is -1 the current date and time are used. If format
00700 is -1, the standard format is used.
00800 ⊗
00900 HERE(ODTIM)
01000 PUSH P,[=100] ; 100 CHARS
01100 PUSHJ P,ZSETST ;GET BP IN 1
01200 MOVE 2,-2(P) ;TIME
01300 MOVE 3,-1(P) ;FORMAT
01400 JSYS ODTIM
01500 PUSH P,[=100]
01600 PUSH P,1 ;UPDATED BP
01700 PUSHJ P,ZADJST ;GET STRING
01800 SUB P,X33 ;ADJUST STACK
01900 JRST @3(P) ;RETURN
00100
00200 DSCR INTEGER SIMPLE PROCEDURE IDTIM(STRING S)
00300 Returns the internal TENEX representation of S, which
00400 is assumed to be the date and time in some reasonable format.
00500 If the format cannot be scanned, the error is returned in .SKIP.
00600
00700 ⊗
00800
00900 HERE(IDTIM)
01000 PUSH P,[0]
01100 PUSHJ P,CATCHR
01200 MOVE 1,(SP) ;BYTE-POINTER
01300 SETZB 2,.SKIP. ;NO SPECIAL FORMAT, ASSUME NO ERROR
01400 JSYS IDTIM
01500 MOVEM 2,.SKIP. ;ERROR TO USER
01600 MOVE 1,2 ;ANSWER
01700 SUB SP,X22 ;ADJUST SP STACK
01800 POPJ P, ;RETURN
00100 DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK; REFERENCE INTEGER CONSOLE);
00200 Returns the runtime of a fork. If FORK=-5, then then
00300 whole job. Time is returned as milliseconds for you. Console time,
00400 similarly converted, is returned in CONSOLE.
00500 ⊗
00600 HERE(RUNTM)
00700 MOVE 1,-2(P)
00800 JSYS RUNTM
00900 MOVEM 3,@-1(P)
01000 SUB P,X33
01100 JRST @3(P)
00100 DSCR INTEGER SIMPLE PROCEDURE GTAD;
00200 Returns the current date and time. See Jsys manual,
00300 3-3.
00400 ⊗
00500 HERE(GTAD)
00600 JSYS GTAD
00700 POPJ P,
00100 DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO);
00200 Returns the TENEX jobnumber. LOGDIR is the directory
00300 no. logged in, CONDIR is the connected directory number. TTYNO is the
00400 TENEX teletype number, which is -1 if the job is detached.
00500 See the DIRST routine for converting directory numbers to
00600 directory strings.
00700 ⊗
00800
00900 HERE(GJINF)
01000 JSYS GJINF
01100 MOVEM 1,@-3(P)
01200 MOVEM 2,@-2(P)
01300 MOVEM 4,@-1(P)
01400 MOVE 1,3;
01500 SUB P,X44
01600 JRST @4(P)
00100 ENDCOM(JOBINF)
00200
00100 COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
00200 ,<DIRECT -- TENEX DIRECTORY SPECS>)
00300 DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
00400 DESR
00500 Returns the directory number associated with a string.
00600 Any problems are returned in .SKIP. with the code:
00700 1 string does not match
00800 2 string is ambiguous.
00900 ⊗
01000 HERE(STDIR)
01100 PUSH P,[0]
01200 PUSHJ P,CATCHR ;TACK ON 0
01300 SETZ 3, ;
01400 MOVEI 1,1 ; ASSUME NO RECOGNITION
01500 SKIPE -1(P) ; DO WE WANT IT?
01600 SETO 1, ; YES AFTER ALL
01700 MOVE 2,(SP) ;BYTE-POINTER
01800 JSYS STDIR
01900 MOVEI 3,1 ; NO MATCH;
02000 MOVEI 3,2 ; AMBIGUOUS
02100 MOVEM 3,.SKIP. ; SAVE IT FOR USER
02200 HRRZ 1,1 ; SAVE DIR NO. (ONLY)
02300 SUB SP,X22 ;ADJUST STRING STACK
02400 SUB P,X22
02500 JRST @2(P) ;RETURN
02600
00100 DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
00200 Returns the string name for directory I. Any problems
00300 cause .SKIP. to be set TRUE.
00400 ⊗
00500
00600 HERE(DIRST)
00700 PUSH P,[=100]
00800 PUSHJ P,ZSETST
00900 SETZM .SKIP.
01000 MOVE 2,-1(P) ;DIRECTORY NO.
01100 JSYS DIRST
01200 SETOM .SKIP.
01300 PUSH P,[=100]
01400 PUSH P,1 ;UPDATED BP
01500 PUSHJ P,ZADJST ;GET STRING ON STACK
01600 SUB P,X22
01700 JRST @2(P)
01800
01900 ENDCOM(DIRECT)
00100 COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
00200 DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
00300 This does two entirely different things depending on whether
00400 NEWFORK is true or not.
00500 If NEWFORK then a new fork is created, capabilities transmitted,
00600 and PROGRAM is run there. INCREM is added to the entry vector. Any problems
00700 cause the routine to return FALSE, otherwise it returns TRUE.
00800 If not NEWFORK then the current job is destroyed and replaced
00900 with PROGRAM, with INCREM added to the entry vector location. This is
01000 like the DEC RUN uuo, and hence if the increment is 1, the program is
01100 started at the CCL address. If the routine returns at all, there was a problem
01200 with the file.
01300 Remember to say .SAV as the PROGRAM extension.
01400 ⊗
01500
01600
01700 HERE(RUNPRG)
01800 BEGIN
01900 JFN←←0
02000 FORK←←14
02100 PUSH P,[0]
02200 PUSHJ P,CATCHR
02300 MOVSI 1,100001 ; OLD FILE, PTR IN 2
02400 MOVE 2,(SP) ; STRING POINTER
02500 JSYS GTJFN ; TRY FOR JFN
02600 JRST RUNERR ; ERROR
02700 MOVEM 1,JFN ; SAVE JFN
02800
02900 SKIPN -1(P) ; USER WANTS FORK?
03000 JRST SWP ; NO, REPLACE CURRENT PRG
03100
03200 MOVSI 1,100000 ; XMIT CAPABILITIES
03300 JSYS CFORK
03400 JRST RUNERR ; CANNOT CREATE FORK
03500 MOVEM 1,FORK ; SAVE HANDLE
03600 SETOB 2,3 ; INDICATE ALL PRIVILEDGES
03700 JSYS EPCAP
03800 HRLZ 1,1 ; FORK HANDLE
03900 HRR 1,JFN ; THE JFN
04000 JSYS GET ; JSYS GET THE FILE
04100 MOVEI 1,400000 ; CURRENT FORK
04200 JSYS GPJFN ;PRIMARY JFNS IN 2
04300 MOVE 1,FORK ; SET PRIMARY IO
04400 JSYS SPJFN ;FOR NEW FORK
04500 MOVE 1,FORK ; FORK
04600 MOVE 2,-2(P) ; USER VALUE FOR ENTRY VECTOR
04700 JSYS SFRKV ;START THE FORK
04800 MOVE 1,FORK ;
04900 JSYS WFORK
05000 SKIPE 1,FORK ; SET TO KILL
05100 JSYS KFORK ;KILL THE FORK
05200 HRRZ 1,JFN ;
05300 JSYS RLJFN ; RELEASE
05400 JFCL ; IGNORE
05500 JRST RUNRET ; AND RETURN SAFELY
05600
05700 SWP:
05800 IMSSS,< ;DESTROY EMULATOR INFO AT IMSSS
05900 SETO 1,
06000 MOVE 2,[XWD 400000,711] ;PAGE 711
06100 JSYS PMAP ;DESTROY
06200 >;IMSSS
06300 PUSH P,JFN ;SAVE THE JFN
06400 HRLI A1 ; BLT INTO ACS
06500 HRRI 1 ;
06600 BLT 15 ; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
06700 POP P,0 ; RESTORE JFN TO AC0
06800 HRLI 0,400000 ; XWD FORK, JFN
06900 MOVE 16,-2(P) ; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
07000 MOVE 17,[254000400010] ; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
07100 JRST 4 ; AND GO
07200 A1: -1 ; FOR PMAP
07300 A2: 400000000677 ; THIS FORK, START AT 677 (LEAVING EMULATOR)
07400 A3: 0 ;
07500 A4: JSYS PMAP
07600 A5: SOJL 2,4 ; LOOP THROUGH PAGES
07700 A6: MOVE 1,0 ; XWD 400000,JFN
07800 A7: JSYS GET ;
07900 A10: MOVEI 1,400000 ; THIS FORK
08000 A11: JSYS GEVEC ; JSYS GET ENTRY VECTOR
08100 A12: CAMN 2,17 ; DEC STYLE??
08200 A13: HRRZ 2,120 ; YES
08300 A14: ADD 2,16 ; ADD THE INCREMREMENT
08400 A15: JRST (2) ; AND START THE JOB
08500
08600 RUNERR: TDZA 1,[-1] ;ZERO 1 AND SKIP
08700 RUNRET: SETO 1, ;INDICATE SUCCESS
08800 SUB SP,X22
08900 SUB P,X33
09000 JRST @3(P)
09100
09200
09300 BEND;RUNPRG
09400 ENDCOM(RUNPRG)
00100 COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00200 DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
00300
00400 Name is the name of the file to be opened. If it is null, then
00500 OPENFILE goes to the user's console for the filname (with recognition).
00600 The value of the call is the jfn returned to the user.
00700 OPTIONS is a string of options available to the user. Legal
00800 characters are:
00900
01000 One of these:
01100 R read
01200 W write
01300 A append
01400 Version numbering
01500 O old file
01600 N new file
01700 T temporary file
01800 * index with INDEXFILE routine
01900
02000 Independent:
02100 C require confirmation
02200 D ignore deleted bit
02300 H "thawed" access
02400 Error handling
02500 E return errors to user in the external
02600 integer !skip!. TENEX error codes are used.
02700 (JFN will be released in this case.)
02800 OPENFILE does a GTJFN followed by a OPENF. If GTJFN fails, a new
02900 attempt is made, from the user's console.
03000 ⊗
03100
03200 BEGIN OPENFILE
03300 JFN←3 ;WHERE TO PUT THINGS
03400 FLAGS←4
03500 GTFLAGS←5
03600 OPFLAGS←6
03700
03800 DEFINE EQ $ (X,Y) <
03900 CAIE A,"$X$"
04000 JRST .+3
04100 TESTO FLAGS,Y
04200 JRST OPCONT
04300 >
04400
04500 DEFINE JTRUE $ (X) <
04600 TESTN FLAGS,X
04700 >
04800 DEFINE JFALSE (X) <
04900 TESTE FLAGS,X
05000 >
05100
05200 DEFINE SGT (X) <
05300 TESTO GTFLAGS,X
05400 >
05500 DEFINE SOF (X) <
05600 TESTO OPFLAGS,X
05700 >
05800 DEFINE TGT (X) <
05900 TESTE FLAGS,X
06000 TESTO GTFLAGS,X
06100 >
06200 DEFINE TOP (X) <
06300 TESTE FLAGS,X
06400 TESTO OPFLAGS,X
06500 >
06600
06700 HERE(OPENFILE)
06800 SETZB FLAGS,.SKIP.
06900 SETZB GTFLAGS,OPFLAGS
07000 HRRZ B,-1(SP) ;COUNT OF OPTIONS WORD
07100
07200 WHIOPT: JUMPE B,OPTDUN
07300 ILDB A,(SP) ;GET AN OPTION
07400 CAIGE A,141
07500 JRST .+3
07600 CAIG A,172
07700 SUBI A,40 ;CONVERT TO UPPER CASE
07800 ;ANY NON-ALPHABETIC CHARS GO HERE
07900
08000 EQ *,STARBIT
08100 ;NOW ALLOW ONLY ALPHABETIC CHARS
08200 CAIL A,101 ;MUST BE
08300 CAILE A,132
08400 JRST OPTERR
08500 SKIPN BITTBL-"A"(A) ;SOMETHING THERE?
08600 JRST OPTERR ;NOPE, ERROR
08700 TDO FLAGS,BITTBL-"A"(A) ;RIGHT SPOT IN TABLE
08800 SOJGE B,WHIOPT
08900 JRST OPTDUN
09000 ;HERE ON ERROR
09100 OPTERR: ERR <OPENFILE: ILLEGAL OPTION >,1
09200 TESTO FLAGS,ERSNBIT
09300
09400 OPCONT:
09500 SOJGE B,WHIOPT
09600
09700 ;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
09800 OPTDUN:
09900 TGT OLDBIT ;INSIST ON OLD?
10000 TGT NEWBIT ;INSIST ON NEW?
10100 JTRUE OLDBIT
10200 JFALSE NEWBIT ;IF NEITHER
10300 JRST OPTDU1 ;WELL, ONE
10400 JTRUE WRBIT ;IF WRITING
10500 JRST OPTDU1
10600 JFALSE RDBIT ;AND READING
10700 JTRUE APPBIT ;BUT NOT APPENDING
10800 SGT OUTBIT ;THEN SET OUTPUT BIT
10900 OPTDU1:
11000 JFALSE RDBIT ;IF READING
11100 JFALSE WRBIT ;AND NOT WRITING
11200 JRST OPTDU2
11300 JTRUE APPBIT ;AND NOT APPENDING
11400 SGT OLDBIT ;THEN INSIST ON OLD
11500 OPTDU2:
11600 ;NOW TEST FOR INDEPENDANT THINGS
11700 TOP RDBIT
11800 TOP WRBIT
11900 TOP APPBIT
12000 TGT TEMBIT
12100 TGT STARBIT
12200 TGT DELBIT
12300 TOP THAWBIT
12400 JFALSE CONFBIT
12500 JRST [SGT CONFB1
12600 SGT CONFB2
12700 JRST .+1]
12800 TLO GTFLAGS,1 ;SHORT CALL OF GTJFN
12900 GTAGAIN:
13000 HRRZ A,-3(SP) ;LENGTH OF NAME
13100 JUMPE A,[TRYAGN:
13200 TLO GTFLAGS,2
13300 MOVE 2,[XWD 100,101]
13400 JRST GT]
13500 AND GTFLAGS,[717777777777]
13600
13700 PUSH SP,-3(SP)
13800 PUSH SP,-3(SP)
13900 PUSH P,[0]
14000 PUSHJ P,CATCHR ;CONCATENATE A NULL CHAR
14100 MOVE 2,(SP) ;BYTE-POINTER
14200 SUB SP,X22 ;ADJUST STACK
14300 GT: MOVE 1,GTFLAGS
14400 JSYS GTJFN
14500 JRST GTERR
14600 MOVEM 1,JFN ;REMEMBER JFN
14700 PUSHJ P,SETCHN ;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
14800 MOVEM 1,CHNL ;REMEMBER CHANNEL
14900 MOVEM GTFLAGS,GFL(CDB)
15000
15100
15200 COMMENT ⊗ Do the open.
15300 ⊗
15400 MOVE 1,DVTYP(CDB) ;CHECK THE DEVICE TYPE
15500 CAIN 1,12 ;IS IT A TTY?
15600 JRST B7 ;YES, USE 7 BIT
15700 B36: HRRZ 1,JFN ;JFN
15800 HRRZ 2,OPFLAGS
15900 HRLI 2,440000 ;36-BIT, MODE 0
16000 JSYS OPENF
16100 JRST B36DMP ;TRY 36-BIT, DUMP MODE
16200 JRST OPNOK
16300 B36DMP: HRRZ 1,JFN
16400 HRRZ 2,OPFLAGS
16500 HRLI 2,447400 ;36 BITS, DUMP MODE
16600 JSYS OPENF
16700 JRST B7
16800 JRST OPNOK
16900 B7: HRRZ 1,JFN
17000 HRRZ 2,OPFLAGS
17100 HRLI 2,70000 ;7 BIT
17200 JSYS OPENF
17300 JRST OPERR ;NOPE
17400 OPNOK: MOVEM 2,OFL(CDB) ;SAVE
17500 MOVE 1,CHNL ;RETURN CHANNEL NO
17600 OPFRET: SUB SP,X44 ;ADJUST
17700 POPJ P, ;AND RETURN
17800
17900
18000
18100
18200 GTERR:
18300 ;HERE WITH ERROR ON GTJFN
18400 JTRUE ERTNBIT ;USER WANT'S ERRORS?
18500 JRST GTER1 ;NO
18600 ERRRET: MOVEM 1,.SKIP. ;STORE FOR USER
18700 SETO 1, ;SOMETHING SUSPICIOUS
18800 JRST OPFRET ;AND RETURN
18900
19000 GTER1: PUSHJ P,SERSTR ;SHOW ERSTR
19100 HRROI 1,[ASCIZ/
19200 Cannot GTJFN file /]
19300 JSYS PSOUT
19400 PUSH SP,-3(SP)
19500 PUSH SP,-3(SP)
19600 PUSHJ P,OUTSTR
19700 HRROI 1,[ASCIZ/, try again */]
19800 JSYS PSOUT
19900 JRST TRYAGN
20000
20100
20200
20300 OPERR: JTRUE ERTNBIT
20400 JRST OPER1
20500 PUSH P,1 ;SAVE ERROR BITS
20600 PUSH P,CHNL
20700 PUSHJ P,CFILE
20800 POP P,1 ;RESTORE ERROR BITS
20900 JRST ERRRET
21000
21100 OPER1: PUSHJ P,SERSTR ;SHOW ERSTR
21200 HRROI 1,[ASCIZ/
21300 Cannot OPENF file /]
21400 JSYS PSOUT
21500 PUSH SP,-3(SP)
21600 PUSH SP,-3(SP)
21700 PUSHJ P,OUTSTR
21800 HRROI 1,[ASCIZ/, try again */]
21900 JSYS PSOUT
22000 PUSH P,CHNL ;CLOSE AND RELEASE FILE AND CDB BLOCK
22100 PUSHJ P,CFILE
22200 JRST TRYAGN
22300
22400 ;HERE WITH THE TENEX ERROR CODE IN 1 -- 1 MAY BE CLOBBERED
22500 SERSTR:
22600 PUSH P,2 ;SAVE ACS
22700 PUSH P,3
22800 HRRZ 2,1
22900 HRLI 2,400000 ;THIS FORK
23000 HRROI 1,[ASCIZ/
23100 /]
23200 JSYS PSOUT
23300 MOVEI 1,101 ;PRIMARY OUTPUT
23400 SETZ 3, ;FLAGS
23500 JSYS ERSTR
23600 JFCL
23700 JFCL
23800 POP P,3
23900 POP P,2
24000 POPJ P,
24100
24200
24300 BITTBL: APPBIT ;A
24400 BINBIT ;B
24500 CONFBIT ;C
24600 DELBIT ;D
24700 ERTNBIT ;E
24800 0 ;F
24900 0 ;G
25000 THAWBIT ;H
25100 0 ;I
25200 0 ;J
25300 0 ;K
25400 0 ;L
25500 0 ;M
25600 NEWBIT ;N
25700 OLDBIT ;O
25800 0 ;P
25900 0 ;Q
26000 RDBIT ;R
26100 0 ;S
26200 TEMBIT ;T
26300 0 ;U
26400 0 ;V
26500 WRBIT ;W
26600 0 ;X
26700 0 ;Y
26800 0 ;Z
26900
27000
27100 BEND OPENFILE
27200
00100 DSCR PROCEDURE SETINPUT(INTEGER CHAN; REFERENCE INTEGER COUNT,BR,EOF)
00200 Sets up the variables associated with input (as in the DEC
00300 open statement.)
00400 ⊗
00500
00600 HERE(SETINPUT)
00700 PUSHJ P,SAVE
00800 VALCHN 1,-4(P),SETERR
00900 POP P,TEMP
01000 POP P,ENDFL(CDB)
01100 SKIPE ENDFL(CDB)
01200 SETZM @ENDFL(CDB) ;ASSUME NOT EOF
01300 POP P,BRCHAR(CDB)
01400 SKIPE BRCHAR(CDB)
01500 SETZM @BRCHAR(CDB) ;ASSUME NO BRCHAR
01600 POP P,ICOUNT(CDB)
01700 SETZ LPSA, ;NO PARAMETERS
01800 SUB P,X11
01900 JRST RESTR
02000 SETERR: ERR <Illegal JFN>,1
02100 MOVE LPSA,[XWD 5,5]
02200 JRST RESTR
02300
00100 DSCR
00200 SETPL(CHAN,@LINNUM,@PAGNUM,@SOSNUM)
00300
00400 Names the variables to be used by the INPUT
00500 function for counting the line-feeds (12), formfeeds (14)
00600 seen by INPUT, as well as keeping the current SOS line
00700 number, if any. Useful when scanning a file, and
00800 you want to know what page,line you are on.
00900 Initializes all three variables to 0.
01000
01100 ⊗
01200 HERE(SETPL)
01300 PUSHJ P,SAVE
01400 VALCHN 1,-4(P),SETPER
01500 POP P,TEMP ;RET ADR
01600 POP P,SOSNUM(CDB)
01700 SETZM @SOSNUM(CDB)
01800 POP P,PAGNUM(CDB)
01900 SETZM @PAGNUM(CDB)
02000 POP P,LINNUM(CDB)
02100 SETZM @LINNUM(CDB)
02200 SUB P,X11 ;REMOVE CHANNEL NO.
02300 SETRET: SETZ LPSA,
02400 JRST RESTR
02500 SETPER: ERR <Illegal JFN>,1
02600 MOVE LPSA,[XWD 5,5]
02700 JRST RESTR
02800
02900
03000
03100
00100 DSCR
00200 BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)
00300
00400 RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
00500 ⊗
00600
00700 HERE(INDEXFILE)
00800 PUSH P,-1(P)
00900 PUSHJ P,CLOSF
01000 PUSH P,-1(P)
01100 PUSHJ P,GNJFN
01200 JUMPE 1,INDRET ;RETURN FALSE IF NO OTHER FILES
01300 PUSH P,2
01400 PUSH P,CDB
01500 PUSH P,CHNL
01600 ;CHANNEL ALREADY VALID
01700 MOVE CHNL,-4(P) ;CHANNEL NUMBER
01800 MOVE CDB,CDBTBL(CHNL) ;CDB LOC
01900 HRRZ 1,JFNTBL(CHNL) ;JFN
02000 MOVE 2,OFL(CDB) ;GET OPENFLAGS
02100 JSYS OPENF ;TRY OPENING
02200 JRST NOIND
02300 SKIPE ENDFL(CDB) ;ZERO SETINPUT (or OPEN) VARIABLES IF HERE
02400 SETZM @ENDFL(CDB)
02500 SKIPE BRCHAR(CDB)
02600 SETZM @BRCHAR(CDB)
02700 SKIPE LINNUM(CDB) ;ZERO SETPL VARS
02800 SETZM @LINNUM(CDB)
02900 SKIPE PAGNUM(CDB)
03000 SETZM @PAGNUM(CDB)
03100 SKIPE SOSNUM(CDB)
03200 SETZM @SOSNUM(CDB)
03300 SETO 1,
03400 INDPOP: POP P,CHNL
03500 POP P,CDB
03600 POP P,2
03700 INDRET: SUB P,X22
03800 JRST @2(P)
03900
04000 NOIND: ERR <INDEXFILE: CANNOT OPENF>,1
04100 SETZ 1,
04200 JRST INDPOP
00100 DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
00200
00300 JFN is a real TENEX jfn. It is inserted in the SAIL
00400 runtime system, and the internal book-keeping is set to
00500 believe that the GTJFN was done with GTFLAGS and the OPENF
00600 with OPFLAGS. JFN may have come from some random source.
00700 ⊗
00800 HERE(SETCHAN)
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X44
01100 MOVE A,-3(P) ;JFN
01200 PUSHJ P,SETCHN
01300 MOVEM A,RACS+A(USER) ;CHANNEL
01400 HRROI A,-1(P) ;PREPARE FOR POPPING
01500 POP A,OFL(CDB) ;MOVE FROM THE STACK
01600 POP A,GFL(CDB)
01700 JRST RESTR
01800
01900 ENDCOM(OPF)
00100 COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
00200 DSCR INTEGER SIMPLE PROCEDURE GTJFN(STRING S; INTEGER FLAGS)
00300 Does a GTJFN. If S is non-null, it is the filename, otherwise
00400 the routine goes to the user's console for a file. FLAGS are used for
00500 accumulator 1, and any error code is returned in .SKIP. The value
00600 of the call is the JFN, if obtained.
00700 Defaults for FLAGS: 0 means ordinary input, 1 means ordinary
00800 output. Ordinarily the user will use the OPENFI routine.
00900 ⊗
01000
01100 HERE(GTJFN)
01200 SKIPN 1,-1(P)
01300 MOVSI 1,100001
01400 CAIN 1,1
01500 MOVSI 1,600001
01600 TLO 1,1 ;MARK FOR SHORT CALL
01700 HRRZ 2,-1(SP)
01800 JUMPE 2,[MOVE 2,[100000101]
01900 TLO 1,2 ;INDICATE XWD JFN,JFN IN 2
02000 JRST GOTDEST]
02100 TLZ 1,2 ;INDICATE BYTE-POINTER IN 2
02200 PUSH P,[0]
02300 PUSHJ P,CATCHR ;PUT ON A NULL
02400 MOVE 2,(SP)
02500 GOTDEST: SETZM .SKIP. ;ASSUME NO ERROR
02600 PUSH P,1 ;SAVE FLAGS
02700 JSYS GTJFN
02800 JRST GTBAD ; SOMETHING IS WRONG
02900 PUSHJ P,SETCHN ;SETUP A CHANNEL, AND ALLOCATE, GET STATUS, SET CDB
03000 POP P,GFL(CDB) ;SAVE FLAGS
03100 GTRET: SUB SP,X22
03200 SUB P,X22
03300 JRST @2(P)
03400
03500 GTBAD:
03600
03700 MOVEM 1,.SKIP. ; REMEMBER
03800 POP P,1 ;ADJUST STACK
03900 SETO 1, ; SOMETHING SUSPICIOUS TO RETURN TO USER
04000 JRST GTRET
04100
00100 DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG; INTEGER FLAGS, XWDJFN!JFN;
00200 STRING DEV,DIR,NAM,EXT,PROT,ACCOUNT; INTEGER DESIRED!JFN)
00300
00400 Does the long form of GTJFN.
00500 ⊗
00600 HERE(GTJFNL)
00700 BEGIN GTJFNL
00800
00900 DEFINE STRPUT(X)<
01000 PUSHJ P,.STPUT
01100 MOVEM A,X
01200 >
01300 DEFINE FLG <-14(P)>
01400 DEFINE IOJFN <-13(P)>
01500 DEFINE DESJFN <-12(P)>
01600 ADD P,[XWD 11,11] ;ROOM FOR LONG-FORM TABLE
01700 TLNN P,400000 ;OVERFLOW?
01800 ERR <GTJFNL: P-stack overflow>
01900 MOVE A,DESJFN
02000 MOVEM A,0(P) ;THE DESIRED JFN
02100 STRPUT -1(P) ;ACCOUNT
02200 STRPUT -2(P) ;PROTECTION
02300 STRPUT -3(P) ;EXTENSION
02400 STRPUT -4(P) ;NAME
02500 STRPUT -5(P) ;DIRECTORY
02600 STRPUT -6(P) ;DEVICE
02700 MOVE A,IOJFN ;XWD INPUT JFN, OUTPUT JFN
02800 MOVEM A,-7(P)
02900 MOVE A,FLG
03000 MOVEM A,-10(P)
03100 STRPUT B ;MAIN STRING POINTER
03200 MOVEI A,-10(P) ;ADDRESS OF BLOCK (ON STACK)
03300 SETZM .SKIP. ;ASSUME NO ERROR
03400 JSYS GTJFN ;LONG FORM
03500 JRST GTLBAD ;NOPE
03600 PUSHJ P,SETCHN ;SET UP CHANNEL TABLE, ALLOCATE, GET STATUS, SET CDB
03700 MOVE B,-10(P) ;GTJFN FLAGS
03800 MOVEM B,GFL(CDB) ;SAVE
03900 GTLRET: SUB P,[XWD 11+4,11+4] ;ADJUST STACK FOR LONG-FORM TABLE, AND ARGUMENTS
04000 JRST @4(P) ;AND RETURN
04100
04200 GTLBAD: MOVEM A,.SKIP. ;RETURN ERROR CODE TO USER
04300 SETO A, ;SOMETHING SUSPICIOUS
04400 JRST GTLRET ;AND RETURN
04500
04600 .STPUT: HRRZ A,-1(SP) ;GET THE COUNT
04700 JUMPE A,[SUB SP,X22 ;ADJUST AND RETURN
04800 POPJ P,]
04900 PUSH P,[0]
05000 PUSHJ P,CATCHR
05100 POP SP,A
05200 SUB SP,X11
05300 POPJ P,
05400
05500
05600 BEND GTJFNL
05700
05800
05900
06000 ENDCOM(GTJFN)
00100 COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
00200 ,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST,FINIO>
00300 ,<FILINF -- UTILITY FILE ROUTINES>)
00400
00500
00600 DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
00700 Does the GNJFN jsys.
00800 ⊗
00900 HERE(GNJFN)
01000 PUSHJ P,SAVE
01100 MOVE LPSA,X22
01200 VALCHN 1,<-1(P)>,GNERR
01300 MOVE 1,JFNTBL(CHNL) ;GET THE WHOLE JFN
01400 JSYS GNJFN
01500 JRST GNRLZ ;FAILURE TO INDEX, RELEASE JFN
01600 MOVEM 1,.SKIP. ;SAVE BITS INDICATING CHANGE
01700 SETOM RACS+A(USER) ;INDICATE SUCCESS
01800 GNRET: JRST RESTR
01900
02000 GNERR: ERR <Illegal JFN>,1
02100 SETZM RACS+A(USER)
02200 JRST RESTR
02300
02400 GNRLZ: SETZM .SKIP. ;NOTHING THERE
02500 SETZM RACS+A(USER) ;FAILURE TO INDEX
02600 PUSH P,-1(P)
02700 PUSHJ P,CFILE ;SO RELEASE FILE
02800 JRST RESTR
02900
00100 DSCR PROCEDURE DELF(INTEGER CHAN)
00200 Deletes file open on CHAN. Errors to .SKIP.
00300 ⊗
00400 HERE(DELF)
00500 PUSH P,1
00600 VALCH1 1,-2(P),DELF1
00700 JSYS DELF
00800 JRST DELF2
00900 SETZM .SKIP. ;NO ERROR
01000 DELFRE: POP P,1
01100 SUB P,X22
01200 JRST @2(P)
01300 DELF1: SETO 1,
01400 DELF2: MOVEM 1,.SKIP.
01500 JRST DELFRE
01600
01700 DSCR INTEGER PROCEDURE DELNF(INTEGER CHAN,NUM)
01800 ⊗
01900 HERE(DELNF)
02000 PUSHJ P,SAVE
02100 MOVE LPSA,X33
02200 VALCH1 1,-2(P),DLNERR
02300 MOVE 2,-1(P)
02400 SETZM .SKIP.
02500 JSYS DELNF
02600 JRST DLNERR
02700 MOVEM 2,RACS+A(USER) ;NUMBER OF FILES DELETED
02800 JRST RESTR
02900 DLNERR: MOVEM 1,.SKIP.;
03000 SETZM RACS+A(USER) ;INDICATE NO FILES DELETED
03100 JRST RESTR
00100 DSCR PROCEDURE UNDELETE(INTEGER CHAN)
00200 Undeletes file open on CHAN. Errors to .SKIP.
00300 ⊗
00400 HERE(UNDELETE)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCH1 1,-1(P),UNDEL1
00800 HRLI 1,1 ;XWD 1,JFN
00900 MOVSI 2,(1B3) ;DELETED BIT
01000 SETZ 3, ;TURN IT OFF
01100 JSYS CHFDB ;CHANGE THE FDB
01200 JRST RESTR
01300 UNDEL1: SETOM .SKIP.
01400 JRST RESTR
01500
01600
01700
01800
00100 DSCR INTEGER PROCEDURE SIZEF(INTEGER JFN)
00200 Gets the size in pages of the file open on JFN, with error code to
00300 .SKIP.
00400 ⊗
00500 HERE(SIZEF)
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X22
00800 VALCHN 1,<-1(P)>,SIZERR
00900 SETZM .SKIP.
01000 JSYS SIZEF
01100 JRST [MOVEM 1,.SKIP.
01200 SETZM RACS+A(USER)
01300 JRST SIZRET]
01400 MOVEM 3,RACS+A(USER) ;ANSWER IN AC 3
01500 SIZRET: JRST RESTR
01600
01700 SIZERR: ERR <Illegal JFN>
01800 SETOM .SKIP.
01900 JRST SIZRET
02000
02100
00100
00200 DSCR STRING SIMPLE PROCEDURE JFNS(INTEGER JFN,FLAGS)
00300 Returns the name of the file associated with JFN.
00400 FLAGS are for ac 3 as described in the jsys manual, with
00500 0 the reasonable default.
00600 ⊗
00700
00800 HERE(JFNS)
00900 VALCHN 2,<-2(P)>,JFNSER ;GET JFN IN AC2
01000 PUSH P,[=400]
01100 PUSHJ P,ZSETST ;GET BP IN AC 1
01200 MOVE 3,-1(P)
01300 JSYS JFNS
01400 PUSH P,[=400]
01500 PUSH P,1
01600 PUSHJ P,ZADJST
01700 JFNSRE: SUB P,X33
01800 JRST @3(P)
01900 JFNSER: ERR <Illegal JFN>,1
02000 PUSH SP,[0] ;RETURN NULL STRING
02100 PUSH SP,[0]
02200 JRST JFNSRE
02300
00100 DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
00200 Does an OPENF.
00300
00400 PARAMETERS:
00500 JFN the JFN
00600 FLAGS for accumulator 2.
00700 .SKIP. the error code (if pertinent)
00800
00900 Some defaults:
01000 FLAGS ACTION
01100 -----------------------
01200 0 INPUT CHARACTERS
01300 1 OUTPUT CHARACTERS
01400 2 INPUT 36-BIT WORDS
01500 3 OUTPUT 36-BIT WORDS
01600 4 DUMP MODE INPUT (USE DUMPI FUNCTION)
01700 5 DUMP MODE OUTPUT (USE DUMPO FUNCTION)
01800 VALUES 6-10 ARE RESERVED FOR EXPANSION
01900
02000 Other values of FLAGS are interpreted literally.
02100 Ordinarily the user will use the OPENFI routine.
02200 ⊗
02300
02400 HERE(OPENF)
02500 PUSHJ P,SAVE
02600 MOVE LPSA,X33
02700 VALCHN 1,-2(P),OPNERR
02800 SKIPL 2,-1(P) ;GET THE FLAGS
02900 CAILE 2,5 ;CHECK IN RANGE 0-5
03000 JRST GOTFLAGS
03100 MOVE 2,OPNTBL(2) ;GET CORRECT WORD
03200 GOTFLAGS:
03300 SETZM .SKIP.
03400 PUSH P,2 ;SAVE FLAGS
03500 JSYS OPENF
03600 JRST NOOPN
03700 POP P,OFL(CDB) ;AND SAVE FLAGS
03800 OPNRET: JRST RESTR
03900
04000 OPNERR: ERR <Illegal JFN>,1
04100 SETOM .SKIP.
04200 JRST OPNRET
04300
04400 NOOPN: MOVEM 1,.SKIP.
04500 SUB P,X11 ;ADJUST STACK
04600 JRST OPNRET
04700
04800 OPNTBL: 070000200000 ;7-BIT READ
04900 070000100000 ;7-BIT WRITE
05000 440000200000 ;36-BIT READ
05100 440000100000 ;36-BIT WRITE
05200 447400200000 ;36-BIT DUMP READ
05300 447400100000 ;36-BIT DUMP WRITE
05400
00100
00200 DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
00300 Closes the file (CLOSF) and releases (RLFJN)
00400 the jfn. This is the ordinary way the user will use
00500 to dispense with a file.
00600 Returns TRUE if JFN legal and released, FALSE o.w.
00700 Always returns.
00800 ⊗
00900
01000 HERE(CFILE)
01100 PUSH P,2
01200 PUSH P,3
01300 PUSH P,CHNL
01400 PUSH P,CDB
01500 SKIPL CHNL,-5(P)
01600 CAIL CHNL,JFNSIZE
01700 JRST CFBAD
01800 MOVE CDB,CDBTBL(CHNL) ;GET CDB
01900 SKIPN 1,JFNTBL(CHNL) ;JFN ASSIGNED?
02000 JRST CFBA1 ;NO, JUST RELEASE CORE
02100 HRRZ 1,1 ;JFN ONLY
02200 PUSHJ P,FINIO ;WRITE OUT REMAINING STUFF, CHECK EOF, MAGTAPE
02300
02400 RLCOR: SKIPE B,CDBTBL(CHNL) ; ANY CORE TO RELEASE?
02500 PUSHJ P,CORREL ; RELEASE THE BLOCK
02600 TLZ 1,400000 ; BE SURE TO RELEASE
02700 JSYS CLOSF ; CLOSE (AND RELEASE)
02800 JFCL ; ERROR RETURN
02900 HRRZ 1,JFNTBL(CHNL) ; GET JFN AGAIN
03000 JSYS RLJFN ; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
03100 JFCL ; ERROR RETURN
03200 SETO 1, ; RETURN TRUE FOR GOOD RELEASE
03300 SETZM CDBTBL(CHNL)
03400 SETZM JFNTBL(CHNL)
03500 CFRET: POP P,CDB
03600 POP P,CHNL
03700 POP P,3
03800 POP P,2
03900 SUB P,X22 ; ADJUST
04000 JRST @2(P) ; RETURN
04100
04200 CFBAD: SETZ 1, ; RETURN FALSE
04300 JRST CFRET ;
04400
04500 CFBA1: SKIPE B,CDB
04600 PUSHJ P,CORREL ;RELEASE CORE BLOCK
04700 SETZM CDBTBL(CHNL) ;REMOVE ALL TRACE
04800 SETZM JFNTBL(CHNL)
04900 SETZ 1, ; RETURN FALSE
05000 JRST CFRET
05100
00100 DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
00200 Does a CLOSF on the JFN. Ordinarily the user
00300 will want to use the CFILE routine, which handles errors
00400 internally. The CLOSF is accomplished in such a way that
00500 the JFN is actually not released.
00600 If the device is a magtape open for output, then
00700 2 eof's are written, followed by a backspace. This writes
00800 a standard end-of-file on the tape.
00900 ⊗
01000 HERE(CLOSF)
01100 PUSHJ P,SAVE
01200 MOVE LPSA,X22
01300 VALCHN 1,<-1(P)>,CLOERR
01400 PUSHJ P,FINIO ;WRITE OUT BUFFERS, SET FDB, WRITE MAGT EOFS, CLEAR BUFFERS
01500
01600 DOCLO: SETZM .SKIP. ;ASSUME NO ERROR
01700 TLO 1,400000 ; DO NOT RELEASE THE JFN
01800 JSYS CLOSF
01900 MOVEM 1,.SKIP. ;ERROR
02000 CLORET: JRST RESTR
02100
02200 CLOERR:
02300 SETOM .SKIP.
02400 JRST CLORET
02500
00100 DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
00200 Does the RLJFN jsys. Ordinarily the user will want
00300 to use the CFILE routine, which handles errors internally.
00400 ⊗
00500
00600 HERE(RLJFN)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 SKIPL C,-1(P)
01000 CAIL C,JFNSIZE
01100 JRST RLJBAD
01200 SKIPN 1,JFNTBL(C)
01300 JRST RLJBAD
01400 SETZM JFNTBL(C)
01500 SKIPE B,CDBTBL(C)
01600 PUSHJ P,CORREL
01700 SETZM CDBTBL(C)
01800 SETZM .SKIP. ;ASSUME NO ERROR
01900 JSYS RLJFN
02000 MOVEM 1,.SKIP. ;ERROR RETURN
02100 RLJRET: JRST RESTR
02200
02300 RLJBAD: ERR <Illegal JFN>,1
02400 SETOM .SKIP.
02500 JRST RLJRET
02600
02700
00100 DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN);
00200 Gets the file status.
00300 WARNING: The results of this call are not necessarily appropriate
00400 if the file is open in special character input mode. If you want to check
00500 for end-of-file, examine the EOF variable instead.
00600 ⊗
00700
00800 HERE(GTSTS)
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X22
01100 VALCHN 1,<-1(P)>,GTSERR
01200 JSYS GTSTS
01300 MOVEM 2,RACS+A(USER)
01400 GTSRET: JRST RESTR
01500
01600 GTSERR: ERR <Illegal JFN>,1
01700 JRST GTSRET
00100 DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS);
00200 Sets the status of JFN to STATUS using the STSTS jsys.
00300 ⊗
00400
00500 HERE(STSTS)
00600 VALCH1 1,<-2(P)>,STSERR
00700 MOVE 2,-1(P)
00800 SETO 3, ;ASSUME SKIP
00900 SETZM .SKIP.
01000 JSYS STSTS
01100 JRST [STERRT: SETZ 3, ;PROBLEM
01200 MOVEM 1,.SKIP.
01300 JRST .+1]
01400 MOVE 1,3 ;RETURN
01500 SUB P,X33
01600 JRST @3(P)
01700
01800 STSERR: ERR <Illegal JFN>,1
01900 JRST STERRT ;RETURN
02000
00100 DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN);
00200 File open on EXISTINGJFN is renamed to file open
00300 on NEWJFN.
00400 ⊗
00500 HERE(RNAMF)
00600 VALCH1 1,<-2(P)>,RNFERR
00700 VALCH1 2,<-1(P)>,RNFERR
00800 SETO 3, ;ASSUME OK
00900 SETZM .SKIP.
01000 JSYS RNAMF
01100 JRST [RNERET: SETZ 3,
01200 MOVEM 1,.SKIP.
01300 JRST .+1]
01400 RNFRET: MOVE 1,3 ;RETURN VALUE
01500 SUB P,X33
01600 JRST @3(P)
01700
01800 RNFERR: ERR <Illegal JFN>,1
01900 JRST RNERET
02000
02100 ENDCOM(FILINF)
00100 COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
00200 ,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST>
00300 ,<DEVINF -- DEVICE AND DIRECTORY ROUTINES>)
00400
00500 DSCR BOOLEAN SIMPLE PROCEDURE CNDIR(INTEGER DIR; STRING PASSWORD);
00600 Using the CNDIR jsys, connects to TENEX directory DIR (for
00700 AC1.) PASSWORD is the password, which will usually be null, as
00800 in the EXEC CONNECT command.
00900 ⊗
01000
01100 HERE(CNDIR)
01200 PUSH P,[0]
01300 PUSHJ P,CATCHR ;PUT A NULL ON THE END OF THE PASSWORD
01400 POP SP,2 ;GET BP IN 2
01500 SUB SP,X11 ;CLEAN UP SP STACK
01600 MOVE 1,-1(P) ;DIRECTORY NO
01700 SETO 3, ;ASSUME SUCCESS
01800 SETZM .SKIP.
01900 JSYS CNDIR
02000 JRST [SETZ 3,
02100 MOVEM 1,.SKIP.
02200 JRST .+1]
02300 MOVE 1,3
02400 SUB P,X22
02500 JRST @2(P)
02600
00100 DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
00200 Assigns the device specified by DEVICE using the ASND jsys.
00300 Returns TRUE if successful, else error code in .SKIP.
00400 ⊗
00500
00600 HERE(ASND)
00700 MOVE 1,-1(P) ;GET DEVICE DESIGNATOR
00800 JSYS ASND
00900 JRST [MOVEM 1,.SKIP.
01000 SETZ 1,
01100 JRST .+2]
01200 SETO 1,
01300 SUB P,X22
01400 JRST @2(P)
00100 DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
00200 Releases DEVICE using the RELD jsys. If DEVICE is -1,
00300 then releases all devices assigned to this job.
00400 ⊗
00500
00600 HERE(RELD)
00700 MOVE 1,-1(P)
00800 JSYS RELD
00900 JRST [MOVEM 1,.SKIP.
01000 SETZ 1,
01100 JRST .+2]
01200 SETO 1,
01300 SUB P,X22
01400 JRST @2(P)
00100 DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN; REFERENCE INTEGER WORDCNT)
00200 Returns the device status of device open on CHAN using the GDSTS
00300 jsys. The LH of WORDCNT has the word count of the last transfer completed,
00400 negative if the last transfer completed unsuccessful.
00500 ⊗
00600
00700 HERE(GDSTS)
00800 VALCH1 1,<-2(P)>,GDSERR
00900 SETZM .SKIP.
01000 JSYS GDSTS
01100 MOVEM 3,@-1(P) ;REFERENCE ARG
01200 MOVE 1,2 ;RETURN VALUE
01300 GDSRET: SUB P,X33
01400 JRST @3(P)
01500 GDSERR: ERR <Illegal JFN>,1
01600 SETOM .SKIP.
01700 SETZ 1,
01800 JRST GDSRET
00100 DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
00200 ⊗
00300 HERE(SDSTS)
00400 VALCH1 1,<-2(P)>,SDSERR
00500 SETZM .SKIP. ;INDICATE NO ERROR
00600 MOVE 2,-1(P)
00700 JSYS SDSTS
00800 SDSRET: SUB P,X33
00900 JRST @3(P)
01000 SDSERR: ERR <Illegal JFN>,1
01100 SETOM .SKIP.
01200 JRST SDSRET
00100 DSCR INTEGER PROCEDURE STDEV(STRING S)
00200 S is a string pointer to a string of the form DTA1.
00300 The device designator is returned.
00400 ⊗
00500
00600 HERE(STDEV)
00700 PUSH P,[0]
00800 PUSHJ P,CATCHR
00900 POP SP,1
01000 SUB SP,X11 ;CLEAN SP STACK
01100 SETZM .SKIP.
01200 JSYS STDEV
01300 JRST [MOVEM 2,.SKIP.
01400 SETZ 1,
01500 JRST .+2]
01600 MOVE 1,2
01700 POPJ P,
01800
00100
00200 DSCR STRING PROCEDURE DEVST(INTEGER DEVICE)
00300 ⊗
00400 HERE(DEVST)
00500 PUSH P,[=100]
00600 PUSHJ P,ZSETST ;GET A BP FOR 100 CHARS
00700 SETZM .SKIP.
00800 MOVE 2,-1(P)
00900 JSYS DEVST
01000 MOVEM 2,.SKIP. ;INDICATE ERROR
01100 PUSH P,[=100]
01200 PUSH P,1 ;UPDATED BP
01300 PUSHJ P,ZADJST
01400 SUB P,X22
01500 JRST @2(P)
01600
00100 DSCR SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)
00200
00300 Entire FDB of JFN is read into BUF. No bounds checking,
00400 so BUF should be at least '26 words.
00500 ⊗
00600 HERE(GTFDB)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X33
00900 VALCHN 1,<-2(P)>,FDBAD
01000 MOVSI 2,25 ;ALL 25 WORDS
01100 HRRZ 3,-1(P) ;ADDRESS OF ARRAY
01200 JSYS GTFDB
01300 JRST RESTR
01400
01500 FDBAD: ERR <Illegal JFN>,1
01600 JRST RESTR
01700
01800 HERE(CHFDB)
01900 DSCR
02000 CHFDB(CHAN,DISPLACEMENT,MASK,CHANGED!BITS)
02100 ⊗
02200 PUSHJ P,SAVE
02300 MOVE LPSA,[XWD 5,5]
02400 VALCHN 1,-4(P),FDBAD ;GET JFN TO 1
02500 HRL 1,-3(P) ;DISPLACEMENT TO LEFT HALF OF ONE
02600 MOVE 2,-2(P)
02700 MOVE 3,-1(P)
02800 JSYS CHFDB
02900 JRST RESTR
03000
00100
00200 ENDCOM(DEVINF)
00300
00400 DEFINE WORDROU < WORDIN,ARRYIN,WORDOUT,ARRYOUT,RWDPTR,SWDPTR >
00500 DEFINE CHARROU < CHARIN,SINI,INPUT,REALIN,REALSCAN,INTIN,INTSCAN,CHAROUT,OUT,LINOUT,RCHPTR,SCHPTR >
00600 DEFINE UTILROU < FINIO >
00700
00800 COMPIL(IOROU,<WORDROU,CHARROU,UTILROU>
00900 ,<JFNTBL,CDBTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
01000 ,<IOROU -- Input and output routines>)
01100
00100 DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
00200 Reads a word in from the file
00300 ⊗
00400 HERE(WORDIN)
00500 BEGIN WORDIN
00600
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 VALCHN 1,-1(P),WERR
01000 SETZEOF ;INDICATE NO EOF
01100
01200 DOSIMIO:SIMIO 2,TABL,WERR
01300 JRST .ADWI
01400 ILDB 2,IOBP(CDB)
01500 STOAC2: MOVEM 2,RACS+A(USER)
01600 JRST RESTR
01700
01800 DOBIN: JSYS BIN
01900 JUMPN 2,STOAC2 ;CANNOT BE END OF FILE
02000 CHKEOF: SETZM RACS+A(USER) ;RETURN 0 IN ANY EVENT
02100 JSYS GTSTS
02200 TESTE 2,1B8 ;EOF?
02300 JRST INPEOF ;YES, INDICATE
02400 JRST RESTR
02500
02600 TABL: JRST DOSETWI ;0 -- SET UP
02700 JRST .CISWI ;1 -- XICHAR
02800 JRST .COSWI ;2 -- XOCHAR
02900 SOSGE IOCNT(CDB) ;3 -- XIWORD
03000 JRST .WOSWI ;4 -- XOWORD
03100 JRST WERR ;5 -- XCICHAR
03200 JRST WERR ;6 -- XCOCHAR
03300 JRST DOBIN ;7 -- XCWORD
03400 REPEAT 4,<JRST WERR> ;10-13
03500
03600 DOSETWI:
03700 PUSHJ P,SETWI
03800 JRST DOSIMIO
03900
04000
04100 .ADWI: PUSHJ P,ADWI
04200 JRST .ADEOF ;END OF FILE
04300 JRST DOSIMIO ;START OVER
04400
04500 .ADEOF: SETZM RACS+A(USER) ;RETURN 0 WORD
04600 JRST INPEOF ;AND INDICATE EOF
04700 WERR: ERR <Dryrot at WORDIN>,1
04800 SETZM RACS+A(USER)
04900 JRST INPEOF ;INDICATING EOF OR ERROR
05000
05100 .CISWI: PUSHJ P,CISWI
05200 JRST DOSIMIO
05300
05400 .COSWI: PUSHJ P,COSWI
05500 JRST DOSIMIO
05600
05700 .WOSWI: PUSHJ P,WOSWI
05800 JRST DOSIMIO
05900
06000
06100 BEND WORDIN
00100 HERE(ARRYIN)
00200 BEGIN ARRYIN
00300
00400 PUSHJ P,SAVE
00500 MOVE LPSA,X44
00600 VALCHN 1,-3(P),WERR
00700 SETZEOF ;ASSUME OK
00800 DOSIMIO:
00900 SIMIO 2,TABL,WERR ;MOVE 6,-2(P)
01000 SKIPGE 2,-1(P) ;EXTENT
01100 ERR <ARRYIN: Negative word count>
01200 WIN3: JUMPE 2,RESTR ;NOTHING LEFT TO TRANSFER
01300 SKIPG E,IOCNT(CDB)
01400 JRST WIN5
01500 IBP IOBP(CDB) ;INCREMENT THE POINTER
01600 HRL C,IOBP(CDB) ;SOURCE
01700 MOVEI D,(6) ;FOR BLT
01800 HRR C,6 ;"TO" ADDRESS
01900 CAIG B,(E) ;ENOUGH HERE
02000 JRST WIN4
02100 ADDI D,-1(E) ;FINISH HERE
02200 BLT C,(D)
02300 ADD 6,E ;FIX INPUT POINTER
02400 SUB B,E ;FIX INPUT COUNT
02500 WIN5: PUSHJ P,ADWI ;GET MORE
02600 JRST ISEOF ;END OF FILE -- NO MORE THERE
02700 JRST WIN3
02800 WIN4: ADDI D,-1(B) ;
02900 BLT C,(D) ;LAST BLT
03000 SUB E,B ;FIX UP COUNT
03100 SOJ B,
03200 MOVEM E,IOCNT(CDB)
03300 ADDM B,IOBP(CDB)
03400 JRST RESTR
03500
03600 TABL: JRST DOSETWI ;0 -- SET UP
03700 JRST .CISWI ;1 -- XICHAR
03800 JRST .COSWI ;2 -- XOCHAR
03900 MOVE 6,-2(P) ;3 -- XIWORD
04000 JRST .WOSWI ;4 -- XOWORD
04100 JRST WERR ;5 -- XCICHAR
04200 JRST WERR ;6 -- XCOCHAR
04300 JRST DOSIN ;7 -- XCWORD
04400 JRST WERR ;10 -- XBYTE7
04500 JRST WERR ;11 -- XDICHAR
04600 JRST WERR ;12 -- XDOCHAR
04700 JRST DODUMPI ;13 -- XDARR
04800
04900 ISEOF: MOVE TEMP,-1(P) ;NUMBER OF WORDS WANTED
05000 SUBM TEMP,B ;INPUT IN RH
05100 WIN2: HRROM B,.SKIP.
05200 SKIPE ENDFL(CDB)
05300 HRROM B,@ENDFL(CDB)
05400 JRST RESTR
05500
05600 .CISWI: PUSHJ P,CISWI
05700 JRST DOSIMIO
05800
05900 .COSWI: PUSHJ P,COSWI
06000 JRST DOSIMIO
06100
06200 .WOSWI: PUSHJ P,WOSWI
06300 JRST DOSIMIO
06400
06500 DOSETWI:
06600 PUSHJ P,SETWI
06700 JRST DOSIMIO
06800
06900 DOSIN:
07000 MOVN 3,-1(P) ;WORD COUNT
07100 MOVSI 2,444400
07200 HRR 2,-2(P) ;ADDRESS OF BUFFER
07300 JSYS SIN
07400 JUMPE 3,RESTR ;DID WE GET IT ALL?
07500 SINEOF: ADD 3,-1(P) ;CALCULATE NO OF WORDS READ
07600 HRLI 3,-1 ;MAKE IT XWD -1,,COUNT
07700 SKIPE ENDFL(CDB) ;EOF LOCATION?
07800 MOVEM 3,@ENDFL(CDB) ;YES
07900 MOVEM 3,.SKIP.
08000 JRST RESTR ;AND RETURN
08100
08200 DODUMPI:
08300 MOVN 3,-1(P)
08400 MOVEI 2,3
08500 HRL 3,3
08600 HRR 3,-2(P) ;ADDRESS OF BUFFER
08700 SUBI 3,1
08800 SETZ 4, ;END OF DUMP MODE COMMAND LIST
08900 JSYS DUMPI ;DO IT
09000 JRST DMPERR
09100 JRST RESTR ;ALL OK
09200
09300 DMPERR: CAIN 1,600220 ;EOF?
09400 JRST DUMPEOF ;NO
09500 ERR <ARRYIN: Dump mode error>,1
09600 MOVEM 1,.SKIP.
09700 JRST RESTR
09800
09900 DUMPEOF:
10000 MOVE 1,DVTYP(CDB)
10100 CAIE 1,2 ;MAGTAPE DEVICE?
10200 JRST INPEOF ;NO JUST INDICATE EOF
10300 HRRZ 1,JFNTBL(CHNL)
10400 SETZ 2, ;MTOPR RESET
10500 JSYS MTOPR
10600 JRST INPEOF ;INDICATE EOF AND RETURN
10700
10800 WERR: ERR <ARRYIN: Illegal JFN, byte-size, or mode.>,1
10900 JRST INPEOF
11000
11100
11200 BEND ARRYIN
00100 HERE(WORDOUT)
00200 BEGIN WORDOUT
00300 PUSHJ P,SAVE
00400 MOVE LPSA,X33
00500 VALCHN 1,-2(P),WERR
00600 SETZEOF
00700 DOSIMIO:SIMIO 2,TABL,WERR ;SOSGE IOCNT(CDB)
00800 JRST .ADWO
00900 MOVE 2,-1(P)
01000 IDPB 2,IOBP(CDB)
01100 JRST RESTR
01200
01300 TABL: JRST DOSETWO ;0 -- XNULL
01400 JRST .CISWO ;1 -- XICHAR
01500 JRST .COSWO ;2 -- XOCHAR
01600 JRST .WISWO ;3 -- XIWORD
01700 SOSGE IOCNT(CDB) ;4 -- XOWORD
01800 JRST WERR ;5 -- XCICHAR
01900 JRST WERR ;6 -- XCOCHAR
02000 JRST DOBOUT ;7 -- XCWORD
02100 REPEAT 4,<JRST WERR> ;10-13
02200
02300 .ADWO: PUSHJ P,ADWO
02400 JRST DOSIMIO
02500
02600 DOSETWO:
02700 PUSHJ P,SETWO
02800 JRST DOSIMIO
02900
03000 .CISWO: PUSHJ P,CISWO
03100 JRST DOSIMIO
03200
03300 .COSWO: PUSHJ P,COSWO
03400 JRST DOSIMIO
03500
03600 .WISWO: PUSHJ P,WISWO
03700 JRST DOSIMIO
03800
03900 WERR: ERR <WORDOUT: Illegal JFN, byte-size, mode, or combination>,1
04000 JRST INPEOF ;AND INDICATE ERROR
04100
04200 DOBOUT: MOVE 2,-1(P)
04300 JSYS BOUT
04400 JRST RESTR
04500
04600 BEND WORDOUT
00100 HERE(ARRYOUT)
00200 BEGIN ARRYOUT
00300
00400 PUSHJ P,SAVE
00500 MOVE LPSA,X44
00600 VALCHN 1,-3(P),WERR
00700 SKIPN 3,-1(P)
00800 JRST RESTR ;NOTHING TO MOVE
00900 JUMPGE 3,.+2
01000 JRST WERR
01100 SETZEOF
01200 DOSIMIO:SIMIO 2,TABL ;MOVE 6-2(P)
01300 SKIPGE B,-1(P)
01400 ERR <ARRYOUT: Word count is negative>,1
01500 WOUT2: SKIPG E,IOCNT(CDB)
01600 JRST WOUT5
01700 JUMPE B,RESTR ;NOTHING LEFT
01800 IBP IOBP(CDB)
01900 MOVE C,IOBP(CDB) ;TO ADDR
02000 HRRZI D,(C) ;FOR BLT TERMINATION
02100 HRLI C,(6)
02200 CAIGE B,(E) ;ENOUGHT IN BUFFER
02300 JRST WOUT3 ;YES
02400 ADDI D,-1(E) ;FINAL ADDRESS
02500 BLT C,(D)
02600 ADDI 6,(E) ;UPDATE BP
02700 SUBI B,(E)
02800 SETZM IOCNT(CDB)
02900 HRRM D,IOBP(CDB)
03000 WOUT5: PUSHJ P,ADWO
03100 JRST WOUT2
03200 WOUT3: JUMPLE B,RESTR
03300 SOJ B,
03400 ADD D,B
03500 BLT C,(D)
03600 SUBI E,1(B)
03700 MOVEM E,IOCNT(CDB)
03800 ADDM B,IOBP(CDB)
03900 JRST RESTR
04000
04100 TABL: JRST DOSETWO ;0 -- XNULL
04200 JRST .CISWO ;1 -- XICHAR
04300 JRST .COSWO ;2 -- XOCHAR
04400 JRST .WISWO ;3 -- XIWORD
04500 MOVE 6,-2(P) ;4 -- XOWORD
04600 JRST WERR ;5 -- XCICHAR
04700 JRST WERR ;6 -- XCOCHAR
04800 JRST DOSOUT ;7 -- XBYTE36
04900 JRST WERR ;10 -- XBYTE7
05000 JRST WERR ;11 -- XDICHAR
05100 JRST WERR ;12 -- XDOCHAR
05200 JRST DODUMPO ;13 -- XDARR
05300
05400 DOSETWO:
05500 PUSHJ P,SETWO
05600 JRST DOSIMIO
05700
05800 .CISWO: PUSHJ P,CISWO
05900 JRST DOSIMIO
06000
06100 .COSWO: PUSHJ P,COSWO
06200 JRST DOSIMIO
06300
06400 .WISWO: PUSHJ P,WISWO
06500 JRST DOSIMIO
06600
06700 DOSOUT:
06800 MOVN 3,-1(P)
06900 MOVSI 2,444400
07000 HRR 2,-2(P)
07100 JSYS SOUT
07200 JRST RESTR
07300
07400 DODUMPO:
07500 MOVN 3,-1(P)
07600 MOVEI 2,3
07700 HRL 3,3
07800 HRR 3,-2(P)
07900 SUBI 3,1
08000 SETZ 4,
08100 JSYS DUMPO
08200 JRST DMPERR
08300 SETOM DMPED(CDB)
08400 JRST RESTR
08500
08600 WERR: ERR <ARRYOUT: Illegal JFN, byte-size, mode, or combination.>,1
08700 JRST INPEOF
08800
08900
09000 DMPERR: ERR <ARRYOUT: Dump mode error>,1
09100 MOVEM 1,.SKIP. ;SAVE TENEX ERROR NUMBER
09200 JRST RESTR
09300
09400
09500 BEND ARRYOUT
00100
00200 HERE(RWDPTR)
00300 BEGIN RWDPTR
00400
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),WERR
00800 SETZM .SKIP.
00900 DOSIMIO:SIMIO 2,TABL,WERR ;PUSHJ P,GETWPT
01000 STOAC2: MOVEM 2,RACS+A(USER)
01100 JRST RESTR
01200
01300 TABL: JRST RNULL ;0 -- XNULL
01400 PUSHJ P,GETWPT ;1 -- XICHAR
01500 PUSHJ P,GETWPT ;2 -- XOCHAR
01600 PUSHJ P,GETWPT ;3 -- XIWORD
01700 PUSHJ P,GETWPT ;4 -- XOWORD
01800 JRST WERR ;5 -- XCICHAR
01900 JRST WERR ;6 -- XCOCHAR
02000 JRST DORFPTR ;7 -- XCWORD
02100 REPEAT 4,<JRST WERR> ;10-13
02200
02300 DORFPTR:
02400 JSYS RFPTR
02500 JRST .+2
02600 JRST STOAC2
02700 ERR <RWDPTR: Cannot do RFPTR.>,1
02800 MOVEM 1,.SKIP.
02900 JRST RNULL
03000 WERR: ERR <RWDPTR: Illegal JFN, illegal mode or byte size.>,1
03100 SETOM .SKIP.
03200
03300 RNULL:
03400 PUSHJ P,SETWIO
03500 JRST DOSIMIO ;AND LOOK AGAIN
03600
03700
03800 BEND RWDPTR
00100 HERE(SWDPTR)
00200 BEGIN SWDPTR
00300
00400 PUSHJ P,SAVE
00500 MOVE LPSA,X33
00600 VALCHN 1,-2(P),WERR
00700 SETZM .SKIP.
00800 DOSIMIO:MOVE 2,-1(P) ;PICK UP NEW WORD IN 2
00900 SIMIO 3,TABL,WERR
01000 JRST RESTR
01100
01200 TABL: JRST RNULL ;0 -- XNULL
01300 PUSHJ P,SETWPT ;1 -- XICHAR
01400 PUSHJ P,SETWPT ;2 -- XOCHAR
01500 PUSHJ P,SETWPT ;3 -- XIWORD
01600 PUSHJ P,SETWPT ;4 -- XOWORD
01700 JRST WERR ;5 -- XCICHAR
01800 JRST WERR ;6 -- XCOCHAR
01900 JRST DOSFPTR ;7 -- XCWORD
02000 REPEAT 4,<JRST WERR> ;10-13
02100
02200 DOSFPTR:JSYS SFPTR
02300 JRST SFERR
02400 JRST RESTR
02500
02600 SFERR: ERR <SWDPTR: Cannot do SFPTR>,1
02700 MOVEM 1,.SKIP.
02800 JRST RESTR
02900
03000 WERR: ERR <SWDPTR: Illegal JFN, byte size, or mode.>,1
03100 SETOM .SKIP.
03200 JRST RESTR
03300
03400 RNULL: PUSHJ P,SETWIO
03500 JRST DOSIMIO
03600
03700 BEND SWDPTR
00100
00200 DSCR
00300 Some auxiliary routines, mostly for word i/o.
00400 ⊗
00500 INPEOF:
00600 ;HERE IF WE HAVE HIT EOF ON INPUT AND WISH TO SIMPLY SAY SO AND RETURN
00700 SETOEOF
00800 JRST RESTR
00900
01000 ;ROUTINES TO SET TO WORD OUTPUT
01100 COSWO: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
01200 CISWO:
01300 WISWO:
01400 PUSHJ P,GTWPT1
01500 MOVEM 3,IOBP(CDB)
01600 MOVEM 4,IOCNT(CDB)
01700 MOVEI 3,XOWORD
01800 MOVEM 3,IOSTT(CDB)
01900 POPJ P,
02000
02100 ;ROUTINES TO SET TO CHARACTER OUTPUT
02200 WOSCO: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
02300 CISCO:
02400 WISCO:
02500 PUSHJ P,GTCPT1
02600 MOVEM 3,IOBP(CDB)
02700 MOVEM 4,IOCNT(CDB)
02800 MOVEI 3,XOCHAR
02900 MOVEM 3,IOSTT(CDB)
03000 POPJ P,
03100
03200
03300 ;ROUTINES TO SET TO CHARACTER INPUT
03400 WOSCI: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
03500 JRST .+2
03600 COSCI: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
03700 WISCI: PUSHJ P,GTCPT1
03800 MOVEM 3,IOBP(CDB)
03900 MOVEM 5,IOCNT(CDB)
04000 MOVEI 3,XICHAR
04100 MOVEM 3,IOSTT(CDB)
04200 POPJ P,
04300
04400 ;ROUTINES TO SET TO WORD INPUT
04500 COSWI: PUSHJ P,CHCEOF ;CHECK FOR NEW CHARACTER EOF
04600 JRST .+2
04700 WOSWI: PUSHJ P,CHWEOF ;CHECK FOR NEW WORD EOF
04800 CISWI: PUSHJ P,GTWPT1
04900 MOVEM 3,IOBP(CDB)
05000 MOVEM 5,IOCNT(CDB)
05100 MOVEI 3,XIWORD
05200 MOVEM 3,IOSTT(CDB)
05300 POPJ P,
05400
05500
05600 SETWND:
05700 ;1, CDB LOADED
05800 ;SETS THE FDB SO THAT THE BYTE SIZE IS 36 AND THE NUMBER OF BYTES IS AS IN 2
05900 PUSH P,2 ;SAVE
06000 PUSH P,3
06100 MOVEM 2,FDBEOF(CDB)
06200 HRLI 1,12 ;OFFSET FOR
06300 MOVEM 2,3 ;NUMBER OF WORDS
06400 SETO 2, ;BYTE MASK
06500 JSYS CHFDB ;CHANGE THE EOF POINTER
06600 MOVEI 2,=36
06700 MOVEM 2,FDBSZ(CDB)
06800 HRLI 1,11 ;OFFSET FOR BYTE SIZE
06900 MOVSI 2,007700 ;MASK
07000 MOVSI 3,004400 ;36 BIT BYTES
07100 JSYS CHFDB
07200 HRLI 1,0 ;RESTORE GOOD JFN IN 1
07300 POP P,3 ;RESTORE
07400 POP P,2
07500 POPJ P, ;AND RETURN
07600
07700
07800 GETWND:
07900 ;HERE WITH 1,CDB LOADED
08000 ;RETURN THE WORD THAT ADDRESSES EOF IN 2, ACCORDING TO THE SYSTEM
08100 BEGIN GETWND
08200 PUSH P,3
08300 PUSH P,4
08400 SKIPN 2,FDBSZ(CDB) ;IF BYTE SIZE IS ZERO
08500 JRST POPBACK ;THEN RETURN
08600 MOVE 3,FDBEOF(CDB)
08700 CAIN 2,=36 ;ALREADY 36?
08800 JRST RET ;YES
08900 CAIE 2,7
09000 ERR <GETWND: File byte size is neither 7 nor 36>,1
09100 IDIVI 3,5 ;CALCULATE BYTES
09200 JUMPE 4,.+2
09300 AOJ 3, ;ACCOUNT FOR REMAINDER
09400 RET: MOVEM 3,2
09500 POPBACK:POP P,4
09600 POP P,3
09700 POPJ P,
09800 BEND GETWND
09900
10000 GETWPT:
10100 ;HERE WITH 1,CDB LOADED
10200 ;RETURNS IN 2 THE WORD THAT ADDRESSES EOB
10300 BEGIN GETWPT
10400 SKIPN 2,IOBP(CDB)
10500 POPJ P, ;WORD ZERO
10600 PUSH P,3
10700 TLZ 2,007700
10800 TLO 2,004400 ;MAKE 36 BIT
10900 IBP 2
11000 MOVE 3,IOADDR(CDB)
11100 SUBI 3,(2)
11200 MOVE 2,IOPAGE(CDB) ;CURRENT PAGE
11300 LSH 2,9 ;NUMBER OF WORDS IN PREVIOUS PAGES
11400 SUB 2,3 ;SUBTRACT SINCE 3 IS NEGATIVE
11500 POP P,3 ;RESULT IN 2
11600 POPJ P,
11700
11800 BEND GETWPT
11900
12000 GTWPT1:
12100 ;HERE WITH 1,CHNL,CDB LOADED
12200 ;RETURN IN 2 THE WORD THAT ADDRESSES EOB IN 2, ACCORDING TO THE CURRENT POINTER
12300 ;RETURN IN 3 THE UPDATED BYTE POINTER
12400 ;RETURN IN 4 THE COUNT REMAINING FOR OUTPUT
12500 ;RETURN IN 5 THE COUNT REMAINING FOR INPUT
12600 BEGIN GTWPT1
12700 SKIPN 3,IOBP(CDB)
12800 JRST NULRET
12900 TLZ 3,007700
13000 TLO 3,004400 ;MAKE A 36-BIT BP
13100 MOVEM 3,2 ;COPY INTO 2
13200 IBP 2
13300 MOVE 4,IOADDR(CDB) ;START OF BUFFER
13400 SUBI 4,(2) ;NUMBER OF WORDS CURRENTLY COMMITTED TO
13500 ;IN THIS BUFFER
13600 MOVE 2,IOPAGE(CDB) ;WHERE THE CURRENT IO IS
13700 LSH 2,9
13800 SUB 2,4 ;NUMBER OF WORDS TO ADDRESS EOF
13900 ADDI 4,1000 ;NUMBER OF WORDS REMAINING IN THIS BUFFER
14000 ;FOR OUTPUT PURPOSES
14100 MOVEM 2,5 ;SAVE CURRENT EOB POINTER
14200 PUSHJ P,GETWND ;READ THE END OF FILE IN FDB
14300 EXCH 5,2 ;EOB POINTER TO 2, EOF TO 5
14400 SUB 5,2 ;SUBTRACT THE CURRENT EOB POINTER
14500 CAML 5,4 ;IF LESS THAN OUTPUT COUNT THEN USE IT ELSE
14600 MOVEM 4,5 ;USE OUTPUT COUNT
14700 POPJ P,
14800
14900 NULRET: SETZB 2,3 ;EVERYTHING ZERO
15000 SETZB 4,5
15100 POPJ P,
15200
15300
15400 BEND GTWPT1
15500
15600 CHWEOF:
15700 ;1,CDB LOADED
15800 ;SEES IF A CHANGE OF EOF IS NEEDED, AND DOES IT
15900 SKIPN IOBP(CDB) ;ANYTHING THERE?
16000 POPJ P, ;NO, DONT FIDDLE AROUND
16100 PUSH P,2
16200 PUSH P,3
16300 PUSHJ P,GETWND ;GET WORD EOF
16400 MOVEM 2,3 ;SAVE IN 6
16500 PUSHJ P,GETWPT ;GET WORD EOB
16600 CAML 2,3 ;IS EOB LESS THAN EOF?
16700 PUSHJ P,SETWND ;BETTER RESET FDB -- ALSO IF TEST IS EQUAL
16800 POP P,3
16900 POP P,2
17000 POPJ P,
17100
17200
00100 SETWPT:
00200 BEGIN SETWPT
00300 ;HERE WITH 1,CDB LOADED
00400 ;2 HAS THE WORD THAT WE WANT TO SET TO
00500 MOVE 3,IOSTT(CDB)
00600 CAIN 3,XOWORD ;DOING WORD OUTPUT?
00700 PUSHJ P,CHWEOF ;YES CHECK
00800 CAIN 3,XOCHAR ;DOING CHAR OUTPUT?
00900 PUSHJ P,CHCEOF ;CHECK IT ALSO
01000 CAMN 2,[-1] ;WANT EOF?
01100 PUSHJ P,GETWND ;YES
01200 PUSH P,2 ;SAVE ON STACK
01300 LSH 2,-9
01400 CAME 2,IOPAGE(CDB) ;SAME PAGE?
01500 PUSHJ P,SETPAGE ;NO, SET THE PAGE
01600 POP P,2
01700 ANDI 2,777 ;PICK UP WORD IN PAGE
01800 MOVE 3,IOADDR(CDB)
01900 ADDI 3,(2)
02000 HRLI 3,444400 ;MAKE A BYTE POINTER
02100 MOVEM 3,IOBP(CDB)
02200 MOVE 3,IOSTT(CDB) ;CHECK THE STATUS AT THE MOMENT
02300 CAIE 3,XICHAR ;IF INPUTTING CHARS
02400 CAIN 3,XIWORD ;OR WORDS
02500 JRST ASSUMIN ;THEN ASSUME WE WILL CONTINUE TO INPUT
02600 MOVEI 3,XOWORD ;WELL ASSUME OUTPUT
02700 MOVEM 3,IOSTT(CDB)
02800 FULBU1: MOVEI 3,1000 ;OTHERWISE ASSUME OUTPUT
02900 SUBI 3,(2)
03000 STOAC3: MOVEM 3,IOCNT(CDB)
03100 POPJ P,
03200 ASSUMIN:
03300 MOVEI 3,XIWORD
03400 MOVEM 3,IOSTT(CDB)
03500 PUSH P,2 ;SAVE THE NUMBER OF WORDS
03600 PUSHJ P,GETWND ;GET THE END OF THE FILE IN WORDS IN 2
03700 IDIVI 2,1000 ;PAGES IN 2, WORDS IN 3
03800 CAMGE 2,IOPAGE(CDB) ;IS REQUESTED PAGE BEYOND EOF?
03900 JRST EMPBUF ;YES
04000 CAME 2,IOPAGE(CDB) ;SOMEWHERE ON THIS PAGE?
04100 JRST FULBUF ;NO
04200 POP P,2
04300 SUB 3,2
04400 JRST STOAC3
04500
04600 FULBUF: POP P,2
04700 JRST FULBU1
04800
04900 EMPBUF: POP P,2
05000 SETZ 3, ;SAY EMPTY
05100 JRST STOAC3
05200 BEND SETWPT
05300
05400 SETPAGE:
05500 ;1,CDB,CHNL LOADED
05600 ;2 HAS THE NUMBER OF THE PAGE WE WANT MAPPED
05700 PUSH P,1 ;SAVE JFN
05800 PUSH P,2
05900 PUSH P,3
06000 MOVEM 2,IOPAGE(CDB) ;PAGE BEING INSERTED
06100 PUSH P,1 ;SAVE JFN OVER SFPTR
06200 LSH 2,9 ;MAKE INTO WORDS
06300 JSYS SFPTR
06400 ERR <SETPAGE: Cannot do SFPTR>,1
06500 POP P,1
06600 HRL 1,1
06700 HRR 1,IOPAGE(CDB) ;XWD JFN,FILEPAGE
06800 HRLZI 3,140000 ;BITS 2 AND 3 FOR READ, WRITE -- ASSUME THIS
06900 MOVE 2,OFL(CDB) ;BUT BETTER CHECK:
07000 TESTN 2,WRBIT ;IF WRITING OR
07100 TESTE 2,APPBIT ;APPENDING
07200 JRST .+2 ;THEN DONT DO
07300 TESTO 3,1B9 ;THE COPY ON WRITE -- DO IT FOR READING THOUGH
07400 MOVE 2,FKPAGE(CDB) ;BUFFER IN CORE
07500 JSYS PMAP
07600 POP P,3
07700 POP P,2
07800 POP P,1 ;RESTORE THE JFN
07900 POPJ P,
08000
00100 SETWIO:
00200 ;1,CDB LOADED
00300 ;DECIDE WHETHER TO SETWI OR SETWO
00400 ;CLOBBERS 2,3
00500 MOVEI 3,SETWI ;ASSUME WORD INPUT
00600 MOVE 2,OFL(CDB)
00700 TESTN 2,RDBIT ;DOING INPUT
00800 MOVEI 3,SETWO ;NOPE ASSUME OUTPUT
00900 JRST (3) ;AND POPJ BACK
00100 ADWI:
00200 ;1,CDB LOADED
00300 ;CALL PUSHJ
00400 ;RETURN:
00500 ; +1 FOR EOF
00600 ; +2 FOR NORMAL
00700 ;ADVANCES WORD INPUT FROM DSK
00800 BEGIN ADWI
00900
01000 PUSH P,2
01100 PUSH P,3
01200 AOS 3,IOPAGE(CDB) ;NEXT PAGE
01300 LSH 3,9 ;WORDS IN THAT PAGE
01400 PUSHJ P,GETWND ;END OF FILE POINTER
01500 CAML 3,2 ;BEYOND
01600 JRST ADEOF ;YES SAY SO
01700 SUB 2,3
01800 CAILE 2,1000 ;LESS THAN A FULL BUFFER?
01900 MOVEI 2,1000 ;NO GIVE ENTIRE AMOUNT
02000 MOVEM 2,IOCNT(CDB)
02100 MOVE 2,IOPAGE(CDB)
02200 PUSHJ P,SETPAGE
02300 MOVE 2,IOADDR(CDB)
02400 HRLI 2,444400
02500 MOVEM 2,IOBP(CDB)
02600 ADRET: AOS -2(P)
02700 ADEOF: POP P,3
02800 POP P,2
02900 POPJ P,
03000
03100 BEND ADWI
03200
03300 ADWO:
03400 ;1,CDB LOADED
03500 ;ADVANCES WORD OUTPUT FROM DSK
03600 BEGIN ADWO
03700
03800 PUSH P,2
03900 AOS 2,IOPAGE(CDB) ;NEXT PAGE OF THE FILE
04000 PUSHJ P,SETPAGE
04100 MOVEI 2,1000
04200 MOVEM 2,IOCNT(CDB)
04300 MOVE 2,IOADDR(CDB)
04400 HRLI 2,444400
04500 MOVEM 2,IOBP(CDB)
04600 POP P,2
04700 POPJ P,
04800
04900 BEND ADWO
00100 DSCR CHAR←CHARIN(CHANNEL)
00200 ⊗
00300 HERE(CHARIN)
00400 BEGIN CHARIN
00500
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X22
00800 LITCHN 1,-1(P),CHALIT
00900 SETZEOF
01000 DOSIMIO:
01100 SIMIO E,TABL,CERR ;SOSGE IOCNT(CDB)
01200 JRST .DOINP
01300 ILDB 2,IOBP(CDB)
01400 STOAC2: MOVEM 2,RACS+A(USER)
01500 JRST RESTR
01600
01700 TABL: JRST DOSETCI ;0 -- XNULL
01800 SOSGE IOCNT(CDB) ;1 -- XICHAR
01900 JRST .COSCI ;2 -- XOCHAR
02000 JRST .WISCI ;3 -- XIWORD
02100 JRST .WOSCI ;4 -- XOWORD
02200 SOSGE IOCNT(CDB) ;5 -- XCICHAR
02300 REPEAT 2,<JRST CERR> ;6,7 -- XCOCHAR,XCOWORD
02400 JRST DOBIN ;10 -- XBYTE7
02500 SOSGE IOCNT(CDB) ;11 -- XDICHAR
02600 REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
02700
02800 .DOINP:
02900 PUSHJ P,ADCI
03000 JRST ADCIEOF ;EOF
03100 JRST DOSIMIO
03200
03300 ADCIEOF:SETZM RACS+A(USER) ;RETURN 0
03400 JRST INPEOF ;AND SAY EOF
03500 DOSETCI:
03600 PUSHJ P,SETCI
03700 JRST DOSIMIO
03800
03900
04000 .COSCI: PUSHJ P,COSCI
04100 JRST DOSIMIO
04200
04300 .WISCI: PUSHJ P,WISCI
04400 JRST DOSIMIO
04500
04600 .WOSCI: PUSHJ P,WOSCI
04700 JRST DOSIMIO
04800
04900 CERR: ERR <CHARIN: Illegal JFN, byte-size, or mode>,1
05000 JRST INPEOF ;INDICATE EOF AND RETURN
05100
05200 CHALIT: SETZM .SKIP.
05300 MOVE 1,-1(P) ;PICK UP JFN LITERALLY
05400 JSYS BIN
05500 JUMPN 2,STOAC2
05600 SETZM RACS+A(USER)
05700 JSYS GTSTS
05800 TESTE 2,1B8
05900 SETOM .SKIP.
06000 JRST RESTR
06100
06200 DOBIN: JSYS BIN
06300 JUMPN 2,STOAC2
06400
06500 SETZM RACS+A(USER) ;ASSUME RETURN 0
06600 JSYS GTSTS
06700 TESTE 2,1B8
06800 JRST INPEOF ;INDICATE EOF
06900 JRST RESTR ;NOT EOF, JUST RETURN
07000
07100 BEND CHARIN
00100 DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
00200 Reads in a string of characters, terminated by BRKCHAR or
00300 reaching maxlength, whichever happens first.
00400 ⊗
00500
00600 HERE(SINI)
00700 BEGIN SINI
00800
00900 PUSHJ P,SAVE
01000 MOVE LPSA,X44
01100 VALCHN 1,-3(P),CERR
01200 SETZEOF
01300 DOSIMIO:SKIPG C,-2(P)
01400 JRST NULRET
01500 SIMIO 2,TABL,CERR ;EXCH 1,C
01600 SKIPE SGLIGN(USER)
01700 PUSHJ P,INSET
01800 ADDM 1,REMCHR(USER)
01900 SKIPLE REMCHR(USER)
02000 PUSHJ P,STRNGC
02100 MOVE E,TOPBYTE(USER) ;BYTE POINTER TO TOP OF STRING SPACE
02200 PUSH SP,[0]
02300 PUSH SP,E
02400 EXCH 1,C ;1 HAS JFN, C HAS COUNT
02500 MOVN C,C
02600 IN1: SOSGE IOCNT(CDB)
02700 JRST .DOINP
02800 IN2: ILDB D,IOBP(CDB)
02900 JUMPE D,IN1 ;IF EMPTY KEEP LOOKING
03000 CAMN D,-1(P) ;BREAK CHAR?
03100 JRST DOBRK ;YES
03200 IDPB D,E
03300 IN3: AOJL C,IN1 ;SUBTRACT 1 AND JUMP IF GREATER
03400
03500 SETOM .SKIP. ;INDICATE TERMINATED FOR COUNT
03600 DONE: ADDM C,REMCHR(USER) ;MAKE REMCHR HONEST
03700 MOVEM E,TOPBYTE(USER)
03800 ADD C,-2(P) ;GET ACTUAL NUMBER OF CHARACTERS
03900 ;TRANSFERRED
04000 HRROM C,-1(SP) ;SAVE COUNT FOR USER
04100 JRST RESTR
04200
04300 DOBRK: IDPB D,E ;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
04400 MOVEM D,.SKIP. ;SAVE BREAK CHARACTER IN .SKIP. AS DOC. SAYS
04500 AOJ C, ;ADD 1 TO THE COUNT
04600 JRST DONE ;AND FINISH UP
04700
04800 B7: MOVEM 1,2 ;SAVE JFN IN 2
04900 PUSH P,-2(P) ;MAXLENGTH
05000 PUSHJ P,ZSETST
05100 EXCH 1,2 ;JFN TO 1, BP TO 2
05200 MOVE 3,-2(P) ;MAXLENGTH
05300 MOVE 4,-1(P) ;OPTIONAL BREAKCHARACTER
05400 JSYS SIN
05500 PUSH P,-2(P) ;MAXLENGTH
05600 PUSH P,2 ;UPDATED BYTE-POINTER
05700 PUSHJ P,ZADJST ;GET STRING ON STACK
05800 JSYS GTSTS ;CHECK STATUS
05900 TESTN 2,1B8 ;EOF?
06000 JRST RESTR ;NO EOF
06100 JRST INPEOF ;YES, AT THE END
06200
06300 CERR: ERR <SINI: Illegal JFN, illegal mode or byte size>,1
06400 NULRET: PUSH SP,[0] ;RETURN NULL STRING
06500 PUSH SP,[0]
06600 JRST RESTR
06700
06800 TABL: JRST DOSETCI ;0 -- XNULL
06900 EXCH 1,C ;1 -- XICHAR
07000 JRST .COSCI ;2 -- XOCHAR
07100 JRST .WISCI ;3 -- XIWORD
07200 JRST .WOSCI ;4 -- XOWORD
07300 EXCH 1,C ;5 -- XCICHAR
07400 JRST CERR ;6 -- XCOCHAR
07500 JRST CERR ;7 -- XCWORD
07600 JRST B7 ;10 -- XBYTE7
07700 EXCH 1,C ;11 -- XDICHAR
07800 REPEAT 2,<JRST CERR> ;12,13 -- XDOCHAR,XDARR
07900
08000 .DOINP: PUSHJ P,DOINP ;READ IN THE NEXT BUFFER
08100 JRST IN1 ;GOT IT
08200 JRST CERR ;IMPOSSIBLE
08300 DOEOF: SETOEOF ;END OF FILE
08400 JRST DONE
08500
08600 DOSETCI:
08700 PUSHJ P,SETCI
08800 JRST DOSIMIO
08900
09000 .COSCI: PUSHJ P,COSCI
09100 JRST DOSIMIO
09200
09300 .WISCI: PUSHJ P,WISCI
09400 JRST DOSIMIO
09500
09600 .WOSCI: PUSHJ P,WOSCI
09700 JRST DOSIMIO
09800
09900
10000 BEND SINI
10100
00100 COMMENT ⊗Input ⊗
00200
00300 DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
00400 CAL SAIL
00500 SID NO ACS SAVED BY INPUT!!!!!!
00600 ⊗
00700
00800 .IN.:
00900 HERE (INPUT)
01000 MOVE USER,GOGTAB ;GET TABLE POINTER
01100 ;;%##% FOR BENEFIT OF ERROR ROUTINE
01200 MOVE TEMP,(P)
01300 MOVEM TEMP,UUO1(USER)
01400 ;;%##%
01500 MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
01600 SKIPE SGLIGN(USER)
01700 PUSHJ P,INSET
01800
01900 VALCHN 1,-2(P),INPBAD ;MOSTLY EXTRA CODE REALLY
02000 INPSIM:
02100 SIMIO E,INPTBL,INPBAD ;MOVE X,-1(P) ; TABLE NUMBER
02200
02300 MOVEI TEMP,-1 ;ERROR IF BLOCK NOT THERE OR TABLE NOT INIT'ED
02400 PUSHJ P,BKTCHK ;CHECK TABLE #
02500 JRST [PUSH SP,[0] ;ERROR
02600 PUSH SP,[0]
02700 SUB P,X33
02800 JRST @3(P)]
02900 PUSH P,CDB ;SAVE POINTER TO CORGET BLOCK
03000 PUSH P,CHNL ;SAVE RANGE 1 TO 18
03100
03200 MOVE CHNL,-4(P) ;CHANNEL NUMBER -- ALREADY CHECKED
03300 MOVE CDB,CDBTBL(CHNL)
03400 HRRZ CHNL,JFNTBL(CHNL);ALREADY CHECKED ABOVE
03500 ;;;; LDB E,[POINT 4,OFL(CDB),9] ;DATA MODE
03600 SETZEOF
03700 SKIPE BRCHAR(CDB) ;BRCHAR LOCATION
03800 SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
03900 MOVEI A,=200 ;DEFAULT NO. OF CHARS
04000 SKIPE ICOUNT(CDB) ;USER-SPECIFIED COUNT?
04100 HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
04200 ADDM A,REMCHR(USER)
04300 SKIPLE REMCHR(USER) ;ENOUGH ROOM?
04400 PUSHJ P,STRNGC ;NO, TRY TO GET SOME
04500
04600 POP P,TEMP
04700 MOVE FF,BRKMSK(TEMP) ;BITS FOR THIS TABLE
04800 POP P,LPSA ;LPSA POINTS AT CORGET BLOCK FOR BREAK TABLES
04900 ADD TEMP,LPSA ;TEMP IS RELOCATED 1 TO 18
05000 MOVEM TEMP,-1(P) ;SAVE RELOCATED 1 TO 18 ON STACK
05100 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
05200 SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
05300 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
05400
05500 MOVN B,A ;NEGATE MAX CHAR COUNT
05600 PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
05700 PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
05800 MOVE Y,LPSA
05900 ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
06000 JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
06100
06200 TRNE FF,@BRKCVT(LPSA) ;DOING UC COERCION?
06300 TLOA C,400000 ;YES
06400 TLZ C,400000 ;NO
06500
06600 .IN: SOSGE IOCNT(CDB) ;BUFFER EMPTY?
06700 JRST .DOINP
06800 IN1:
06900 ILDB D,IOBP(CDB) ;GET NEXT CHARACTER
07000 TDNE Z,@IOBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
07100 JRST INLINN ;YES, GO SEE WHAT TO DO
07200 IN2:
07300 INB: JUMPE D,.IN ;ALWAYS IGNORE 0'S
07400 SKIPN LINNUM(CDB) ;COUNTING VIA SETPL FUNCTION??
07500 JRST INB1 ;NO
07600 CAIN D,12 ;LINE-FEED?
07700 AOS @LINNUM(CDB) ;INDICATE ANOTHER LINE
07800 CAIE D,14 ;FORM-FEED?
07900 JRST INB1 ;NO
08000 SKIPE PAGNUM(CDB)
08100 AOS @PAGNUM(CDB) ;COUNT PAGES ALSO
08200 SKIPE LINNUM(CDB)
08300 SETZM @LINNUM(CDB) ;SET LINNUM TO ZERO (NEW PAGE)
08400
08500 INB1: JUMPGE C,NOCV.I ;NOT COERCING?
08600 CAIL D,"a" ;ONLY COERCE LOWER CASE
08700 CAILE D,"z" ;
08800 JRST .+2 ;SPECIAL RHT "FAST SKIP"
08900 TRZ D,40 ;MAKE UPPER CASE
09000
09100 NOCV.I: TDNE FF,@Y ;MUST WE DO SOMETHING SPECIAL?
09200 JRST INSPC ;YES, HANDLE
09300
09400 MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
09500 AOJL B,.IN ;GET SOME MORE
09600 JRST DONE1
09700
09800 INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
09900 TDNN TEMP,FF ; (CHOOSE ONE)
10000 JRST .IN ;IGNORE
10100
10200 ; BREAK -- STORE BREAK CHAR, FINISH OFF
10300
10400 DONE: SKIPE BRCHAR(CDB) ;USER BRCHAR VAR?
10500 MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
10600 MOVE TEMP,-1(P) ;RELOCATED 1 TO 18
10700 SKIPN Y,DSPTBL(TEMP) ;WHAT TO DO WITH BREAK CHAR?
10800 JRST DONE1 ;SKIP IT
10900 JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
11000
11100 RETAIN: PUSHJ P,BACKUP
11200 JRST DONE1
11300
11400 APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
11500 AOJA B,DONE1 ;ONE MORE TO COUNT
11600
11700
11800 ; DONE -- MARK STRING COUNT WORD
11900
12000 DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
12100 SKIPN ICOUNT(CDB) ;USER SUPPLIED COUNT?
12200 JRST [ADDI B,=200 ;USER DEFAULT
12300 JRST .+2]
12400 ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
12500 ;;#GI# DCS 2-5-72 REMOVE TOPSTR
12600 HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
12700 ;;#GI#
12800 MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
12900 SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
13000 JRST @3(P) ;RETURN
13100
13200 ; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
13300 ; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
13400 ; NOT A LINE NUMBER FOR NEXT TIME
13500
13600
13700
13800
00100 .DOINP: PUSHJ P,DOINP
00200 JRST .IN ;NORMAL BUFFERED RETURN
00300 JRST INB ;7-BIT, CHAR IN D
00400 JRST DONE1 ;EOF OR ERROR
00500
00600 BEGIN INPTBL
00700
00800 ↑INPTBL:JRST DOSETCI ;0 -- XNULL
00900 MOVE X,-1(P) ;1 -- XICHAR
01000 JRST .COSCI ;2 -- XOCHAR
01100 JRST .WISCI ;3 -- XIWORD
01200 JRST .WOSCI ;4 -- XOWORD
01300 MOVE X,-1(P) ;5 -- XCICHAR
01400 REPEAT 2,<JRST INPBAD> ;6,7
01500 MOVE X,-1(P) ;10 -- XBYTE7
01600 MOVE X,-1(P) ;11 -- XDICHAR
01700 REPEAT 2,<JRST INPBAD> ;12,13
01800
01900 DOSETCI:
02000 PUSHJ P,SETCI
02100 JRST INPSIM
02200
02300 .COSCI: PUSHJ P,COSCI
02400 JRST INPSIM
02500
02600 .WISCI: PUSHJ P,WISCI
02700 JRST INPSIM
02800
02900 .WOSCI: PUSHJ P,WOSCI
03000 JRST INPSIM
03100
03200
03300 BEND INPTBL
03400
00100
00200 COMMENT ⊗ BACKUP TO BACKUP JFN ⊗
00300
00400 ;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED
00500 ↑BACKUP:
00600 PUSH P,1
00700 LDB 1,[POINT 6,OFL(CDB),5] ;BYTE-SIZE
00800 CAIN 1,44
00900 JRST BACKU1
01000 ;HERE USE BKJFN
01100 HRRZ 1,CHNL ;THE JFN
01200 JSYS BKJFN
01300 ERR <BACKUP: CANNOT DO RETAIN MODE ON THIS FILE>,1
01400 BACRET: POP P,1
01500 POPJ P,
01600 BACKU1: SOS IOBP(CDB)
01700 IBP IOBP(CDB)
01800 IBP IOBP(CDB)
01900 IBP IOBP(CDB)
02000 IBP IOBP(CDB)
02100 AOS IOCNT(CDB)
02200 JRST BACRET
02300
02400 ;LINE NUMBER STUFF
02500
02600 INLINN:
02700 NOPGNN:
02800 SKIPE SOSNUM(CDB) ;WANT THE NUMBER?
02900 JRST [MOVE TEMP,@IOBP(CDB) ;SAVE IT FOR THE USER
03000 MOVEM TEMP,@SOSNUM(CDB)
03100 JRST .+1]
03200 MOVE TEMP,-1(P) ;RELOCATED TABLE
03300 SKIPGE TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
03400 JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
03500
03600 JSP TEMP,EATLIN ;TOSS IT OUT, AND
03700 JRST .IN ; CONTINUE
03800
03900 EATLIN:
04000 AOS IOBP(CDB) ;FORGET IT ENTIRELY
04100 MOVNI A,5 ;INDICATE SKIPPING SIX
04200 ADDB A,IOCNT(CDB) ;IN COUNT
04300 JUMPGE A,(TEMP) ;OVERFLOW BUFFER??
04400 PUSHJ P,DOINP
04500 JRST OKLN ;36-BIT RETURN
04600 ERR <INPUT: 7-BIT BYTES CANNOT HAVE LINE NUMBERS>
04700 JRST DONE1 ;END-OF-FILE
04800 OKLN:
04900 IBP IOBP(CDB) ;GET OVER TAB FINALLY
05000 SOS IOCNT(CDB) ;IS THIS RIGHT -- RLS 12/74
05100 JRST (TEMP) ;AND CONTINUE
05200
05300
05400 GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
05500 JRST GVLLN ;NO, WANTS IT NEXT TIME.
05600 SKIPL TEMP,@IOBP(CDB) ;NEGATED LINE NO
05700 MOVNS TEMP
05800 SKIPE BRCHAR(CDB) ;USER LOCATION?
05900 MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
06000 JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
06100 JRST DONE1 ;FINISH UP
06200 GVLLN:
06300 SKIPE BRCHAR(CDB)
06400 SETOM @BRCHAR(CDB) ;TELL THE USER
06500 AOS IOCNT(CDB) ;REVERSE THE SOSLE
06600 MOVE Y,OFL(CDB) ;NOW CHECK TO SEE IF WE CAN DO THIS WITHOUT DISASTER
06700 TESTN Y,WRBIT ;WRITING?
06800 TESTE Y,APPBIT ;OR APPENDING?
06900 ERR <INPUT: Give line feature not implemented when reading and writing.
07000 Continuation will cause the line number to be modified.>
07100 MOVEI Y,1 ;TURN OFF LINE NUMBER
07200 ANDCAM Y,@IOBP(CDB) ; BIT
07300 MOVSI Y,070000 ;BACK UP BYTE POINTER
07400 ADDM Y,IOBP(CDB)
07500 JRST DONE1 ;FINISH OFF IN BAZE OF GORY
07600
07700 INPBAD: ERR <INPUT: Illegal JFN or bad input>
07800
00100 COMMENT ⊗Realin, Realscan ⊗
00200
00300 DSCR REAL←REALIN(CHANNEL NUMBER);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (REALIN)
00800 IFN ALWAYS,<BEGIN NUMIN>
00900
01000 PUSHJ P,SAVE
01100 PUSHJ P,NUMIN; GET NUMBER IN A AND TEN EXPONENT IN C
01200 MOVE LPSA,X22
01300 JRST REALFN
01400
01500 DSCR REAL←REALSCAN(@"STRING");
01600 CAL SAIL
01700 ⊗
01800
01900 HERE (REALSCAN)
02000 PUSHJ P,SAVE
02100 PUSHJ P,STRIN
02200 MOVE LPSA,X33
02300 REALFN: SETZ D,; POS SIGN
02400 JUMPE A,ADON
02500 JUMPG A,FPOS
02600 SETO D,; NUMBER NEGATIVE
02700 MOVNS A
02800 FPOS: ;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
02900 JFFO A,.+1; NUMBER OF LEADING ZEROS IN B
03000 ASH A,-1(B); BIT0=0, BIT1=1
03100 MOVN X,B; BIN EXPONENT -2
03200 JUMPE C,FLO; IF TEN EXPONENT ZERO THEN FINISH
03300 JUMPL C,FNEG
03400 CAIL C,100; CHECK BOUND OF EXPOENT
03500 JRST ERROV1
03600 SETZ Y,
03700 JRST TEST
03800 FNEG: MOVNS C
03900 CAIL C,100
04000 JRST ERROV1
04100 MOVEI Y,6
04200 TEST: TRNE C,1; DEPENDING ON LOW ORDER BIT OF EXP
04300 JRST MULT; EITHER MULTIPLY
04400 NEXT: ASH C,-1; OR DON'T.
04500 AOJA Y,TEST; INDEX INTO MULTIPLIER TABLE
04600 MULT: ADD X,.CH.(Y); EXPONENT
04700 MUL A,.MT.(Y) ;MULTIPLY AND NORMALIZE
04800 TLNE A,200000
04900 JRST DTEST
05000 ASHC A,1
05100 SOJA X,.+1
05200 DTEST: SOJG C,NEXT
05300 FLO: IDIVI A,1B18
05400 FSC A,255
05500 FSC B,234
05600 FADR A,B
05700 SKIPE D
05800 MOVNS A
05900 FSC A,(X); SCALE
06000 JRST ALLDON
06100 SUBTTL INTIN INTEGER NUMBER INPUT ROUTINE LOU PAUL
00100 COMMENT ⊗Intin, Intscan ⊗
00200
00300 DSCR INTEGER←INTIN(CHANNEL NUMBER);
00400 CAL SAIL
00500 ⊗
00600
00700 HERE (INTIN)
00800 ;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
00900 ;USES NUMIN TO PERFORM FREE FIELD SCAN
01000
01100 PUSHJ P,SAVE
01200 PUSHJ P,NUMIN; GET NUMBER IN A, TEN EXPONENT IN C
01300 MOVE LPSA,X22
01400 JRST INTFN
01500
01600 DSCR INTEGER←INTSCAN("STRING");
01700 CAL SAIL
01800 ⊗
01900
02000 HERE (INTSCAN)
02100 PUSHJ P,SAVE
02200 PUSHJ P,STRIN
02300 MOVE LPSA,X33
02400 INTFN: JUMPE A,ADON
02500 JUMPE C,ADON
02600 JUMPL C,DIVOUT; IF EXPONENT NEG WE WILL DIVIDE
02700 CAIL C,13
02800 JRST ERROV1
02900 IMUL A,.TEN.(C)
03000 JRST ALLDON
03100 DIVOUT: MOVNS C
03200 CAIL C,13
03300 JRST [SETZ A,
03400 JRST ADON ]
03500 MOVE C,.TEN.(C)
03600 IDIV A,C
03700 ASH C,-1
03800 CAML B,C; ROUND POSITIVELY
03900 AOJA A,ALLDON
04000 MOVNS B
04100 CAML B,C
04200 SOJ A,
04300 ALLDON: JOV ERROV1; CHECK FOR OVERFLOW
04400 ADON: MOVEM A,RACS+1(USER)
04500 JRST RESTR
04600 ERROV1: PUSHJ P,ERROV
04700 JRST ADON
04800 SUBTTL FREE FIELD NUMBER SCANNER LOU PAUL
00100 DSCR NUMIN
00200 DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
00300 ⊗
00400 ;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
00500 ;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
00600 ;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
00700 ;SCANNING IS ACCORDING TO THE FOLLOWING BNF
00800 ;<NUMBER>::=<DEL><SIGN><NUM><DEL>
00900 ;<NUM> ::=<NO>|<NO><EXP>|<EXP>
01000 ;<NO> ::=<INTEGER>|<INTEGER>.|
01100 ; <INTEGER>.<INTEGER>|.<INTEGER>
01200 ;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
01300 ;<EXP> ::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
01400 ;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
01500 ;<SIGN> ::=+|-|<EMPTY>
01600 ;NULL AND CARR. RET. ARE IGNORED.
01700 ;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
01800 ;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
01900 ;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
02000 ;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
02100 ;CLASS 0 NULL, CARR RET, NOTHING
02200 ;CLASS 1 .
02300 ;CLASS 2 -
02400 ;CLASS 3 +
02500 ;CLASS 4 @,E
02600 ;CLASS 5 ANY OTHER CHARACETR
02700 ;CLASS 6 END OF FILE
02800 ;TAB(200) IS USED FOR FND OF FILE
02900 ;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
03000 ;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
03100 DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
03200 HRRE X,TAB(D)
03300 JRST @.+2(X)
03400 JUMP DIG
03500 JRST .-4
03600 JUMP POINT
03700 JUMP MINUS
03800 JUMP PLUS
03900 JUMP E
04000 JUMP CHA
04100 JUMP EOF>
04200
04300 DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
04400 SETZ X,
04500 LSHC X,3
04600 JRST @.+1(X)
04700 JUMP NULL
04800 JUMP POINT
04900 JUMP MINUS
05000 JUMP PLUS
05100 JUMP E
05200 JUMP CHA
05300 JUMP CHA>
00100 ;NUMIN -- CONTD.
00200
00300 NUMIN:
00400 SKIPL CHNL,-2(P) ;
00500 CAIL CHNL,JFNSIZE
00600 PUSHJ P,NUMBAD
00700 MOVE CDB,CDBTBL(CHNL)
00800 SKIPN CHNL,JFNTBL(CHNL)
00900 PUSHJ P,NUMBAD
01000 SKIPE ENDFL(CDB)
01100 SETZM @ENDFL(CDB)
01200 SETZM .SKIP.
01300 SKIPE BRCHAR(CDB)
01400 SETZM @BRCHAR(CDB)
01500
01600 MOVE LPSA,[JSP X,NCH]
01700 ?NUMSIM:
01800 SIMIO Z,NUMTBL,NUMBAD ;MOVEI Z,1 -- FOR LINE NUMBER TEST
01900 PUSHJ P,SCAN
02000 SKIPE BRCHAR(CDB) ;USER WANTS BREAK CHARACTER?
02100 MOVEM D,@BRCHAR(CDB) ;FIX UP BREAK CHARACTER
02200 SOS IOBP(CDB) ;BACK UP TO GET IT NEXT TIME
02300 FOR II←1,4 <
02400 IBP IOBP(CDB)>
02500 AOS IOCNT(CDB)
02600 POPJ P,
02700
02800 ; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
02900 NCH: SOSGE IOCNT(CDB); DECREMENT CHARACTER COUNT
03000 JRST NUMINP
03100
03200 NCH1: ILDB D,IOBP(CDB); LOAD BYTE
03300 TDNE Z,@IOBP(CDB); CHECK FOR LINE NUMBER
03400 JRST NCH5
03500 NCH1.1: SKIPN LINNUM(CDB) ;WANT SETPL THINGS?
03600 JRST (X) ;NO RETURN
03700 CAIN D,12 ;LINE FEED?
03800 AOS @LINNUM(CDB) ;YES
03900 CAIE D,14 ;FORM FEED?
04000 JRST (X) ;NOPE, NOTHING
04100 SKIPE PAGNUM(CDB)
04200 AOS @PAGNUM(CDB) ;INCREMENT PAGE COUNTER
04300 SKIPE LINNUM(CDB)
04400 SETZM @LINNUM(CDB) ;AND ZERO LINE COUNTER
04500 JRST (X); RETURN
04600
04700 NCH7: MOVEI D,200 ;EOF OR DATA ERROR.
04800 JRST (X)
04900
05000 NCH5: SKIPE SOSNUM(CDB) ;WANT SETPL STUFF?
05100 JRST [MOVE D,@IOBP(CDB)
05200 MOVEM D,@SOSNUM(CDB) ;INFORM USER ABOUT LINE NUMBER
05300 JRST .+1]
05400 AOS IOBP(CDB); WE HAVE A LINE NUMBER
05500 MOVNI D,5; MOVE OVER IT
05600 ADDB D,IOCNT(CDB)
05700 SKIPL D ;NOTHING LEFT?
05800 JRST NCH ;DO ANOTHER INPUT
05900 PUSHJ P,DOINP ;
06000 JRST NCH6 ;36-BIT RETURN -- MUST BE
06100 PUSHJ P,NUMBAD ;IMPOSSIBLE
06200 JRST NCH7 ;EOF OR SOME SUCH
06300
06400 NCH6: SOSGE IOCNT(CDB); REMOVE TAB
06500 JRST NCH7 ;NONE THERE OR ERROR
06600 IBP IOBP(CDB)
06700 JRST NCH
06800
06900 ;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
07000 STRIN: MOVE LPSA,[JSP X,NCHA]
07100 HRRZ Z,-3(P)
07200 HRRZ Z,-1(Z)
07300 HRRZS -3(P) ;SO CAN INDIRECT THROUGH IT.
07400 PUSHJ P,SCAN
07500 HRRZ X,-3(P)
07600 SOS (X) ;BACK UP BYTE POINTER
07700 FOR II←1,4<
07800 IBP (X)>
07900 AOJ Z,
08000 HRRM Z,-1(X)
08100 MOVEM D,@-2(P) ;STORE BREAK CHARACTER
08200 POPJ P,
08300
08400 ;READ A CHARACTER ROUTINE FOR STRINGS.
08500 NCHA: SOJL Z,NCH7
08600 ILDB D,@-4(P)
08700 JRST (X)
08800
00100 ;SCAN (CALLED BY NUMIN AND STRIN)
00200
00300 SCAN: JOV .+1
00400 SETO TEMP, ;FLAG REGISTER.
00500 SETZ Y,
00600 SETZB A,C; NUMBER EXPOENT
00700 MORE: XCT LPSA; THIS GETS A CHARACTER IN D,200 IF FO EOF
00800 AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
00900 STACK: LSHC X,-3; PUSH SYMBOL ONTO STACK "AC Y"
01000 JRST MORE
01100
01200 DIG1: SETZ TEMP,; FLAG REG.
01300 ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
01400
01500 SIG1: TRO TEMP,4; NEGATIVE SIGN
01600 SIG2: ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
01700
01800 EXP1: MOVEI A,1
01900 ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
02000
02100 SIG3: MOVNS A
02200 SIG4: ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
02300
02400 FRA1: TRO TEMP,1; DECIMAL POINT
02500 SOJ C,
02600 ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
02700
02800 SIG5: TRO TEMP,4; NEGATIVE SIGN
02900 SIG6: ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
03000
03100 EXP2: HLRE FF,TAB(D); FIRST DIGIT
03200 EXP5: XCT LPSA; GET NEXT CHARACTER
03300 EXP9: HLRE B,TAB(D)
03400 JUMPL B,EEXP; NEGATIVE IF NOT A DIGIT
03500 IMULI FF,12
03600 ADD FF,B
03700 JRST EXP5
03800
03900 XCT LPSA
04000 ;;#QD# SEE DONE5: BELOW
04100 EEXP: AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
04200 EN: TRNE TEMP,4; SIGN OF EXPONENT
04300 MOVNS FF
04400 ADD C,FF; FIX UP EXPONENT
04500 JOV ERR3
04600
04700 ;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
04800 ;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
04900 DONE5:
05000 DONE: ANDI D,177
05100 JUMPGE TEMP,.+2
05200 SETO D,
05300 POPJ P,
05400
05500 INT1: HLRE A,TAB(D); FIRST DIGIT
05600 TRNE TEMP,4
05700 MOVNS A; NEGATE IF NECESSARY
05800 INT2: XCT LPSA; GET NEXT CHARACTER
05900 INT5: HLRE B,TAB(D)
06000 JUMPL B,EON; NEGATIVE IF NOT A NUMBER
06100 TRNE TEMP,1; IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
06200 SOJ C,
06300 TRNE TEMP,2; IF ENOUGH DIGITS THEN INC EXP BY ONE
06400 INT3: AOJA C,INT2
06500 MOVE X,A
06600 IMULI A,12
06700 TRNE TEMP,4; NEGATE DIGIT IS SIGN NEGATIVE
06800 MOVNS B
06900 ADD A,B
07000 JOV INT4; CHECK FOR OVERFLOW
07100 JRST INT2; IF SO USE LAST VALUE
07200
07300 INT4: TRO TEMP,2
07400 MOVE A,X
07500 JRST INT3
07600
07700 XCT LPSA
07800 EON: AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
07900
08000 DP1: TROE TEMP,1
08100 JRST ERR2
08200 XCT LPSA
08300 ;#QD# (SEE DONE5: ABOVE)
08400 AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)
08500
08600 EXP6: SETZ TEMP,
08700 XCT LPSA
08800 AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
08900
09000 EXP7: TRO TEMP,4
09100 EXP8: XCT LPSA
09200 ;#QD# (SEE DONE5: ABOVE)
09300 AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)
09400
09500 ERR1: ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
09600
09700 ERR2: ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
09800
09900 ERR3: ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
10000
10100 ERR5: ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
10200
10300 ERROV: ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
10400
10500 NUMBAD: ERR<NUMIN: Illegal JFN, byte-size or mode>
10600 POPJ P,
10700
10800
10900 BEGIN NUMTBL
11000
11100 ↑NUMTBL:JRST DOSETCI ;0 -- XNULL
11200 MOVEI Z,1 ;1 -- XICHAR
11300 JRST .COSCI ;2 -- XOCHAR
11400 JRST .WISCI ;3 -- XIWORD
11500 JRST .WOSCI ;4 -- XOWORD
11600 MOVEI Z,1 ;5 -- XCICHAR
11700 REPEAT 2,<JRST NUMBAD> ;6,7
11800 MOVEI Z,1 ;10 -- XBYTE7
11900 MOVEI Z,1 ;11 -- XDICHAR
12000 REPEAT 2,<JRST NUMBAD> ;12,13
12100
12200 DOSETCI:
12300 PUSHJ P,SETCI
12400 JRST NUMSIM
12500
12600 .COSCI: PUSHJ P,COSCI
12700 JRST NUMSIM
12800
12900 .WISCI: PUSHJ P,WISCI
13000 JRST NUMSIM
13100
13200 .WOSCI: PUSHJ P,WOSCI
13300 JRST NUMSIM
13400
13500 BEND NUMTBL
13600
13700 NUMINP: PUSHJ P,DOINP
13800 JRST NCH ;BUFFERED INPUT
13900 JRST NCH1.1 ;7-BIT
14000 JRST NCH7 ;EOF OR ERROR
14100
14200
14300 RZ: SETZ A,
14400 JRST DONE
00100 ; Character table for SCAN (Realscan,Intscan,Realin,Intin)
00200 TAB: FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
00300 >
00400 FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
00500 >
00600 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
00700 >
00800 ;#QC# MAKE 32 (CONTROL Z) IGNORED
00900 FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
01000 >
01100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
01200 >
01300 FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
01400 >
01500 FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
01600 >
01700 FOR A IN (5,5,5,5,5,5)<XWD -1,A
01800 >
01900 FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
02000 >
02100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02200 >
02300 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02400 >
02500 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02600 >
02700 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02800 >
02900 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03000 >
03100 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03200 >
03300 FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03400 >
03500 XWD -1,6
03600
03700 ENDCOM(NUM)
03800 COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
00100 DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
00200 ⊗
00300
00400 ↑↑.CH.: 4
00500 7
00600 16
00700 33
00800 66
00900 153
01000 777777777775
01100 777777777772
01200 777777777763
01300 777777777746
01400 777777777713
01500 777777777626
01600 ↑↑.MT.: 240000000000
01700 310000000000
01800 234200000000
01900 276570200000
02000 216067446770
02100 235613266501
02200 314631463147
02300 243656050754
02400 321556135310
02500 253630734215
02600 346453122767
02700 317542172553
02800 ↑↑.TEN.: 1
02900 =10
03000 =100
03100 =1000
03200 =10000
03300 =100000
03400 =1000000
03500 =10000000
03600 =100000000
03700 =1000000000
03800 =10000000000
03900
04000 ENDCOM(TBB)
04100 IFN ALWAYS,<
04200 BEND
04300 >;IFN ALWAYS
00100
00200 DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN, CHAR)
00300 ⊗
00400 HERE(CHAROUT)
00500 BEGIN CHAROUT
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X33
00800 LITCHN 1,-2(P),CHOLIT
00900 DOSIMIO:SIMIO 3,TABL,CERR ;SOSGE IOCNT(CDB)
01000 PUSHJ P,ADCO1
01100 MOVE 2,-1(P)
01200 IDPB 2,IOBP(CDB)
01300 JRST RESTR
01400
01500 TABL: JRST DOSETCO ;0 -- XNULL
01600 JRST .CISCO ;1 -- XICHAR
01700 SOSGE IOCNT(CDB) ;2 -- XOCHAR
01800 JRST .WISCO ;3 -- XIWORD
01900 JRST .WOSCO ;4 -- XOWORD
02000 JRST CERR ;5 -- XCICHAR
02100 SOSGE IOCNT(CDB) ;6 -- XCOCHAR
02200 JRST CERR ;7 -- XCWORD
02300 JRST DOBOUT ;10 -- XBYTE7
02400 JRST CERR ;11 -- XDICHAR
02500 SOSGE IOCNT(CDB) ;12 -- XDOCHAR
02600 JRST CERR ;13 -- XDARR
02700
02800 DOSETCO:
02900 PUSHJ P,SETCO
03000 JRST DOSIMIO
03100
03200 .CISCO: PUSHJ P,CISCO
03300 JRST DOSIMIO
03400
03500 .WISCO: PUSHJ P,WISCO
03600 JRST DOSIMIO
03700
03800 .WOSCO: PUSHJ P,WOSCO
03900 JRST DOSIMIO
04000
04100 CERR: ERR <CHAROUT: Illegal JFN, byte-size, or mode.>,1
04200 JRST RESTR
04300
04400 CHOLIT:
04500 DOBOUT: MOVE 2,-1(P)
04600 JSYS BOUT
04700 JRST RESTR
04800
04900 BEND CHAROUT
00100
00200 DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
00300 ⊗
00400 HERE(OUT)
00500 BEGIN OUT
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X22
00800 LITCHN 1,-1(P),DOSOUT
00900 DOSIMIO:SIMIO 2,TABL,CERR ;HRRZ 3,-1(SP)
01000 JUMPE 3,SOURET ;DONT SEND EMPTY STRING
01100 LOOP: SOSGE IOCNT(CDB) ;DECREMENT BUFFER COUNT
01200 PUSHJ P,ADCO1 ;GET NEW BUFFER
01300 ILDB 2,(SP) ;NEXT CHAR ON STRING
01400 IDPB 2,IOBP(CDB) ;AND COPY THE CHARACTER
01500 SOJG 3,LOOP ;STRING CHAR COUNT
01600
01700 SOURET: SUB SP,X22 ;ADJUST STRING STACK
01800 JRST RESTR
01900
02000 ;USE BOUTS SINCE SOUT DOESNT WORK AT IMSSS
02100 DOSOUT: HRRZ 3,-1(SP)
02200 JUMPE 3,SOURET
02300 SOUT1: ILDB 2,(SP) ;NEXT CHAR
02400 JSYS BOUT
02500 SOJG 3,SOUT1 ;STRING CHAR COUNT
02600 JRST SOURET
02700
02800 CERR: ERR <OUT: Illegal JFN, byte-size, or mode>,
02900 JRST SOURET
03000
03100 TABL: JRST DOSETCO ;0 -- XNULL
03200 JRST .CISCO ;1 -- XICHAR
03300 HRRZ 3,-1(SP) ;2 -- XOCHAR
03400 JRST .WISCO ;3 -- XIWORD
03500 JRST .WOSCO ;4 -- XOWORD
03600 JRST CERR ;5 -- XCICHAR
03700 HRRZ 3,-1(SP) ;6 -- XCOCHAR
03800 JRST CERR ;7 -- XCWORD
03900 JRST DOSOUT ;10 -- XBYTE7
04000 JRST CERR ;11 -- XDICHAR
04100 HRRZ 3,-1(SP) ;12 -- XDOCHAR
04200 JRST CERR ;13 -- XDARR
04300
04400 DOSETCO:
04500 PUSHJ P,SETCO
04600 JRST DOSIMIO
04700
04800 .CISCO: PUSHJ P,CISCO
04900 JRST DOSIMIO
05000
05100 .WISCO: PUSHJ P,WISCO
05200 JRST DOSIMIO
05300
05400 .WOSCO: PUSHJ P,WOSCO
05500 JRST DOSIMIO
05600
05700 BEND OUT
05800
00100 DSCR PROCEDURE LINOUT(INTEGER JFN,VALUE)
00200 ⊗
00300
00400 HERE(LINOUT)
00500 BEGIN LINOUT
00600
00700 PUSHJ P,SAVE
00800 VALCHN A,-2(P),LINBAD
00900 DOSIMIO:SIMIO B,TABL,LINBAD ;SKIPG B,IOCNT(CDB)
01000 PUSHJ P,ADCO ;NO, SEND (OR PERHAPS JUST INITIALIZE)
01100 MOVE TEMP,IOBP(CDB) ;GET BP
01200
01300 LINOPL: TLNN TEMP,760000 ;LINED BP?
01400 JRST OKLIGN
01500 IBP TEMP
01600 SOJA B,LINOPL
01700
01800 OKLIGN: MOVEM TEMP,IOBP(CDB)
01900 MOVEM B,IOCNT(CDB)
02000 CAIGE B,=10 ;ENOUGH FOR 10 CHARS?
02100 PUSHJ P,ADCO ;NO
02200 SKIPGE B,-1(P) ;GET LINE-NO
02300 JRST [MOVNS B
02400 MOVNI A,5
02500 JRST NOCONV]
02600 MOVNI A,6
02700 MOVE C,[<ASCII /00000/>/2]
02800 EXCH B,C
02900 PUSH P,LNBAK
03000 LNCONV: IDIVI C,=10
03100 IORI D,"0"
03200 DPB D,[POINT 7,(P),6]
03300 SKIPE C
03400 PUSHJ P,LNCONV ;THE RECURSIVE PRINTER
03500 HLL C,(P)
03600 LSHC B,7
03700 LNBAK: POPJ P,.+1
03800 LSH B,1
03900 TRO B,1
04000 NOCONV: AOS C,IOBP(CDB) ;MOVE A WORD OUT
04100 MOVEM B,(C)
04200 ADDM A,IOCNT(CDB)
04300 MOVEI B,11
04400 CAME A,[-5]
04500 IDPB B,IOBP(CDB) ;OUTPUT A TAB
04600 NOTAB: MOVE LPSA,X33
04700 JRST RESTR
04800
04900 LINBAD: ERR <LINOUT: Illegal JFN, byte-size, or mode>,1
05000 JRST NOTAB
05100
05200 TABL: JRST DOSETCO ;0 -- XNULL
05300 JRST .CISCO ;1 -- XICHAR
05400 SKIPG B,IOCNT(CDB) ;2 -- XOCHAR
05500 JRST .WISCO ;3 -- XIWORD
05600 JRST .WOSCO ;4 -- XOWORD
05700 JRST LINBAD ;5 -- XCIWORD
05800 SKIPG B,IOCNT(CDB) ;6 -- XCOWORD
05900 JRST LINBAD ;7 -- XCWORD
06000 JRST LINBAD ;10 -- XBYTE7
06100 JRST LINBAD ;11 -- XDICHAR
06200 SKIPG B,IOCNT(CDB) ;12 -- XDOCHAR
06300 JRST LINBAD ;13 -- XDARR
06400
06500 DOSETCO:
06600 PUSHJ P,SETCO
06700 JRST DOSIMIO
06800
06900 .CISCO: PUSHJ P,CISCO
07000 JRST DOSIMIO
07100
07200 .WISCO: PUSHJ P,WISCO
07300 JRST DOSIMIO
07400
07500 .WOSCO: PUSHJ P,WOSCO
07600 JRST DOSIMIO
07700
07800
07900 BEND LINOUT
08000
00100 HERE(RCHPTR)
00200 BEGIN RCHPTR
00300 PUSHJ P,SAVE
00400 MOVE LPSA,X22
00500 VALCHN 1,-1(P),CERR
00600 SETZM .SKIP.
00700 DOSIMIO:SIMIO 2,TABL,CERR
00800 STOAC2: MOVEM 2,RACS+A(USER)
00900 JRST RESTR
01000
01100 TABL: JRST RNULL ;0 -- XNULL
01200 REPEAT 4,<PUSHJ P,GETCPT> ;1-4
01300 REPEAT 3,<JRST CERR> ;5-7
01400 JRST DORFPTR ;10 -- XBYTE7
01500 REPEAT 3,<JRST CERR>
01600
01700 DORFPTR:
01800 JSYS RFPTR
01900 JRST .+2
02000 JRST STOAC2
02100 ;HERE WITH AN ERROR FROM RFPTR
02200 MOVEM 1,.SKIP.
02300 JRST RNULL
02400
02500 CERR: ERR <RCHPTR: Illegal jfn, mode, or byte size>,1
02600 SETOM .SKIP.
02700 SETZM RACS+A(USER)
02800 JRST RESTR
02900
03000 RNULL:
03100 PUSHJ P,SETCIO
03200 JRST DOSIMIO
03300
03400 BEND RCHPTR
00100 HERE(SCHPTR)
00200 BEGIN SCHPTR
00300 PUSHJ P,SAVE
00400 MOVE LPSA,X33
00500 VALCHN 1,-2(P),CERR
00600 SETZM .SKIP.
00700 DOSIMIO:MOVE 2,-1(P) ;POINTER
00800 SIMIO 3,TABL,CERR
00900 JRST RESTR
01000
01100 TABL: JRST RNULL ;0 -- XNULL . Remember arg in 2
01200 PUSHJ P,SETCPT ;1 -- XICHAR
01300 PUSHJ P,SETCPT ;2 -- XOCHAR
01400 PUSHJ P,SETCPT ;3 -- XIWORD
01500 PUSHJ P,SETCPT ;4 -- XOWORD
01600 REPEAT 3,<JRST CERR> ;5-7
01700 JRST DOSFPTR ;10 -- XBYTE7
01800 REPEAT 3,<JRST CERR> ;11-13
01900
02000 RNULL:
02100 PUSHJ P,SETCIO
02200 JRST DOSIMIO ;BUT GET ARGUMENT AGAIN
02300
02400 DOSFPTR:
02500 JSYS SFPTR
02600 JRST .+2 ;ERROR IN 1
02700 JRST RESTR
02800 MOVEM 1,.SKIP.
02900 ERR <SCHPTR: Cannot do SFPTR>,1
03000 JRST RESTR
03100
03200 CERR: ERR <Dryrout at SCHPTR>,1
03300 SETOM .SKIP.
03400 JRST RESTR
03500
03600
03700 BEND SCHPTR
00100 DSCR Auxiliary routines for character i/o.
00200 ⊗
00300
00400 SETCND:
00500 ;sets the FDB so tht the byte size is 7 and the number of bytes is as in 2
00600 ;1, CHNL, CDB loaded
00700 ;call is PUSHJ
00800 PUSH P,2
00900 PUSH P,3
01000 MOVEM 2,FDBEOF(CDB)
01100 HRLI 1,12 ;OFFSET
01200 MOVEM 2,3 ;NEW COUNT
01300 SETO 2, ;MASK FOR CHANGED BITS
01400 JSYS CHFDB ;NEW NUMBER OF BYTES TO END
01500 MOVEI 2,=7
01600 MOVEM 2,FDBSZ(CDB)
01700 HRLI 1,11
01800 MOVSI 2,007700 ;MASK
01900 MOVSI 3,000700 ;AND CHANGED BITS
02000 JSYS CHFDB ;NEW BYTE SIZE
02100 HRLI 1,0 ;LEAVE JFN IN 1
02200 POP P,3
02300 POP P,2
02400 POPJ P,
02500
02600 GETCND:
02700 ;returns in 2 the character count that addresses EOF according to the FDB
02800 ;1, CDB loaded
02900 BEGIN GETCND
03000 PUSH P,3
03100 SKIPN 2,FDBSZ(CDB)
03200 JRST POPBACK
03300 MOVE 3,FDBEOF(CDB)
03400 CAIN 2,=7 ;7-BIT?
03500 JRST RET ;YES, RETURN
03600 CAIE 2,=36
03700 ERR <GETCND: File byte size is neither 36 or 7>,1
03800 IMULI 3,5 ;CONVERT TO CHARACTERS
03900 RET: MOVEM 3,2 ;RESULT IN 2
04000 POPBACK:POP P,3
04100 POPJ P,
04200 BEND GETCND
04300
04400 BEGIN GETCPT
04500 ;ROUTINES FOR CHAR EOB
04600
04700 ↑↑GETCPT:
04800 ;1,CDB LOADED
04900 ;RETURNS IN 2 THE END OF BUFFER CHARACTER
05000 SKIPN 2,IOBP(CDB)
05100 POPJ P, ;RETURN 0
05200 PUSH P,3
05300 TLZ 2,007700
05400 TLO 2,000700 ;MAKE A 7-BIT POINTER
05500 IBP 2 ;INCREMENT
05600 HRRZM 2,3 ;ADDRESS
05700 HRRI 2,BYTES
05800 LDB 2,2
05900 SUB 3,IOADDR(CDB) ;SUBTRACT
06000 IMULI 3,5 ;CHARACTERS
06100 ADDI 3,(2) ;PLUS THESE IN EXTRA WORD
06200 MOVE 2,IOPAGE(CDB)
06300 IMULI 2,1000*5 ;PREVIOUS PAGES IN THE FILE
06400 ADDI 2,(3) ;PLUS THESE
06500 POP P,3
06600 POPJ P, ;RETURN IN 2
06700
06800
06900 ↑↑GTCPT1:
07000 ;1, CHNL, CDB loaded
07100 ;call PUSHJ
07200 ;returns the following
07300 ; 2 how many characters until the end of the buffer
07400 ; 3 bp to first free character
07500 ; 4 count for character output
07600 ; 5 count for character input
07700 SKIPN 3,IOBP(CDB)
07800 JRST RET
07900 TLZ 3,007700
08000 TLO 3,000700 ;MAKE A 7-BIT POINTER
08100 MOVEM 3,2 ;COPY IN 2
08200 IBP 2
08300 HRRZM 2,4 ;ADDRESS
08400 HRRI 2,BYTES
08500 LDB 2,2 ;NUMBER OF ADDTL CHARS
08600 SUB 4,IOADDR(CDB) ;ADDRESS OF BUFFER
08700 IMULI 4,5
08800 ADDI 4,(2)
08900 MOVE 2,IOPAGE(CDB)
09000 IMULI 2,1000*5
09100 ADDI 2,(4)
09200 MOVNI 4,(4)
09300 ADDI 4,1000*5
09400 MOVEM 2,5 ;SAVE 2
09500 PUSHJ P,GETCND ;GET CHAR EOF
09600 EXCH 5,2
09700 SUB 5,2
09800 CAML 5,4
09900 MOVEM 4,5
10000 POPJ P,
10100
10200 BYTES: BYTE (7) 0,1,2,3,4
10300
10400 RET: SETZB 2,3 ;NOT INITIALIZED
10500 SETZB 4,5
10600 POPJ P,
10700
10800 BEND GETCPT
10900
11000 CHCEOF:
11100 ;CHECKS TO SEE IF CHARACTER EOF POINTER NEEDS RESETTING
11200 ;1, CDB LOADED
11300 SKIPN IOBP(CDB) ;DONT CHECK IF NOTHING THERE
11400 POPJ P,
11500 PUSH P,2
11600 PUSH P,3
11700 PUSHJ P,GETCND ;GET CHARACTER EOF IN 2
11800 MOVEM 2,3 ;SAVE IN 6
11900 PUSHJ P,GETCPT ;GET CHARACTER EOB IN 2
12000 CAML 2,3 ;NEED RESETTING?
12100 PUSHJ P,SETCND ;YES
12200 POP P,3
12300 POP P,2
12400 POPJ P,
12500
00100 SETCPT:
00200 ;1,CDB LOADED
00300 ;2 HAS THE BYTE IN THE FILE TO SET TO
00400 BEGIN SETCPT
00500
00600 MOVE 3,IOSTT(CDB)
00700 CAIN 3,XOWORD ;PREVIOUSLY DOING WORD OUTPUT?
00800 PUSHJ P,CHWEOF ;YES CHECK EOF
00900 CAIN 3,XOCHAR ;PREVIOUSLY DOING CHAR OUTPUT
01000 PUSHJ P,CHCEOF ;CHECK EOF
01100 CAMN 2,[-1] ;WANT EOF?
01200 PUSHJ P,GETCND ;YES, GET IN 2
01300 IDIVI 2,1000*5 ;PAGE BEING REQUESTED
01400 CAME 2,IOPAGE(CDB) ;SAME AS CURRENT
01500 PUSHJ P,SETPAGE ;NO GET NEW PAGE
01600 MOVE 2,IOADDR(CDB)
01700 MOVEM 3,5 ;NUMBER OF CHARS IN THIS BUFFER
01800 IDIVI 3,5 ;WORDS TO 3, BYTES TO 4
01900 ADDI 2,(3) ;3 STILL HAS THE CHAR IN THIS PAGE
02000 HLL 2,BPS(4)
02100 MOVEM 2,IOBP(CDB)
02200 MOVE 3,IOSTT(CDB)
02300 CAIE 3,XICHAR
02400 CAIN 3,XIWORD
02500 JRST ASSUMIN
02600 MOVEI 3,XOCHAR
02700 MOVEM 3,IOSTT(CDB)
02800 FULBUF: MOVEI 3,1000*5
02900 SUBI3: SUBI 3,(5)
03000 STOAC3: MOVEM 3,IOCNT(CDB)
03100 POPJ P,
03200 ASSUMIN:
03300 MOVEI 3,XICHAR
03400 MOVEM 3,IOSTT(CDB)
03500 PUSHJ P,GETCND ;GET THE CHARACTER END OF FILE
03600 IDIVI 2,1000*5 ;PAGES IN 2, CHARS IN 3
03700 CAMGE 2,IOPAGE(CDB) ;IS REQUESTED PAGE BEYOND EOF?
03800 JRST EMPBUF ;YES, NO INPUT THERE
03900 CAME 2,IOPAGE(CDB) ;ON THIS PAGE?
04000 JRST FULBUF ;NO
04100 JRST SUBI3 ;SUBTRACT ALREADY COMMITTED
04200
04300 EMPBUF: SETZ 3,
04400 JRST STOAC3
04500
04600 BPS: POINT 7,0,-1
04700 POINT 7,0,6
04800 POINT 7,0,13
04900 POINT 7,0,20
05000 POINT 7,0,27
05100
05200 BEND SETCPT
00100 SETCIO:
00200 ;1,CDB LOADED
00300 ;DECIDE WHETHER TO SETCI OR SETCO
00400 MOVEI 3,SETCI ;ASSUME CHARACTER INPUT
00500 MOVE 2,OFL(CDB)
00600 TESTN 2,RDBIT ;DOING INPUT?
00700 MOVEI 3,SETCO ;NOPE ASSUME OUTPUT
00800 JRST (3) ;AND POPJ RETURN
00100 DSCR
00200 ADCI
00300
00400 Accepts: 1 jfn
00500 CDB channel data block
00600
00700 Call: PUSHJ
00800
00900 Returns: +1 for eof
01000 +2 for good input
01100
01200 Resets values in the CDB
01300 ⊗
01400
01500 BEGIN ADCI
01600
01700 ↑↑ADCI: PUSH P,1
01800 PUSH P,2
01900 PUSH P,3
02000 SIMIO 2,TABL,ADCERR ;AOS 3,IOPAGE(CDB)
02100 IMULI 3,1000*5 ;NEXT CHARACTER
02200 PUSHJ P,GETCND ;CHARACTER EOF IN 2
02300 CAML 3,2 ;IS IT BEYOND
02400 JRST ADEOF ;YES -- CONFESS THAT IT IS
02500 SUB 2,3
02600 CAILE 2,1000*5 ;LESS THAN A FULL BUFFER
02700 MOVEI 2,1000*5 ;NO
02800 MOVEM 2,IOCNT(CDB)
02900 MOVE 2,IOPAGE(CDB)
03000 PUSHJ P,SETPAGE ;GET NEXT PAGE
03100 MOVE 2,IOADDR(CDB)
03200 HRLI 2,440700 ;MAKE A BYTE-POINTER
03300 MOVEM 2,IOBP(CDB)
03400 ADRET: AOS -3(P) ;INCREMENT PC WORD
03500 ADEOF: POP P,3 ;EOF -- DONT INCREMENT
03600 POP P,2
03700 POP P,1
03800 POPJ P, ;RETURN
03900
04000 TABL: JRST ADCERR ;0 -- XNULL
04100 AOS 3,IOPAGE(CDB) ;1 -- XICHAR
04200 REPEAT 3,<JRST ADCERR> ;2-4
04300 JRST DOSIN ;5 -- XCICHAR
04400 REPEAT 3,<JRST ADCERR> ;6-10
04500 JRST DODUMPI ;11 -- XDICHAR
04600 REPEAT 2,<JRST ADCERR> ;12,13
04700
04800 ADCERR: ERR <Dryrot at ADCI>,1
04900 JRST ADEOF
05000
05100
05200 DOSIN: MOVE 2,IOADDR(CDB)
05300 HRL 3,2
05400 HRRI 3,1,(2)
05500 SETZM (2)
05600 BLT 3,777(2)
05700 HRLI 2,444400
05800 MOVNI 3,1000
05900 JSYS SIN
06000 CAMG 3,[-1000]
06100 JRST [CAMN 3,[-1000] ;EOF?
06200 JRST ADEOF
06300 JRST .+1]
06400 ADDI 3,1000 ;NUMBER OF WORDS READ
06500 IMULI 3,5 ;NUMBER OF CHARACTERS
06600 STOCNT: MOVEM 3,IOCNT(CDB)
06700 MOVE 2,IOADDR(CDB)
06800 HRLI 2,440700
06900 MOVEM 2,IOBP(CDB)
07000 JRST ADRET ;AND RETURN
07100
07200 DODUMPI:
07300 PUSH P,1 ;SAVE JFN OVER POSSIBLE DUMPI ERROR
07400 PUSH P,4
07500 MOVE 3,IOADDR(CDB)
07600 HRL 2,3
07700 HRRI 2,1(3)
07800 SETZM (3)
07900 BLT 2,777(3)
08000 SOJ 3,
08100 HRLI 3,-1000 ;MAKE AN IOWD
08200 MOVEI 2,3 ;COMMAND LIST STARTS AT 3
08300 SETZ 4, ;AND ENDS AT 4
08400 JSYS DUMPI
08500 JRST DMIERR
08600 MOVEI 3,1000*5
08700 POP P,4
08800 POP P,1
08900 JRST STOCNT
09000
09100 DMIERR: CAIE 1,600220 ;EOF?
09200 ERR <ADCI: Dump mode input error>,1
09300 POP P,4 ;RESTORE
09400 POP P,1 ;PRECIOUS JFN
09500 MOVE 2,DVTYP(CDB) ;GET DEVICE TYPE
09600 CAIE 2,3 ;MAGTAPE?
09700 JRST ADEOF ;NO, JUST INDICATE EOF
09800 SETZ 2, ;MTOPR RESET
09900 JSYS MTOPR
10000 JRST ADEOF ;AND SAY WE ARE AT THE END OF THE FILE
10100
10200
10300 BEND ADCI
00100 DOINP:
00200 ;CHNL has the JFN
00300 ;CDB has the channel data block
00400 ;returns +1 for good buffered input
00500 ; +2 for 7-bit input with char in D
00600 ; +3 for eof or error
00700 BEGIN DOINP
00800 PUSH P,1 ;SAVE 1
00900 PUSH P,2
01000 MOVE 1,CHNL ;JFN
01100 MOVE D,IOSTT(CDB) ;D IS FREE
01200 CAIE D,XBYTE7 ;7-BIT?
01300 JRST DOBUFF
01400 JSYS BIN
01500 JUMPE 2,CHKEOF ;IF 0 MAY BE EOF
01600 MOVEM 2,D ;STORE
01700 MOVE 2,DVTYP(CDB) ;IS THE DEVICE A TTY?
01800 CAIE 2,12 ;
01900 JRST DOB7 ;NO
02000 CAIN D,32 ;A CONTROL-Z?
02100 JRST DOIEOF ;YES INDICATE EOF
02200 CAIN D,37 ;PHONEY BBN EOL?
02300 MOVEI D,12 ;A LINE-FEED
02400 JRST DOB7 ;AND RETURN
02500
02600 CHKEOF: JSYS GTSTS ;BETTER CHECK
02700 TESTE 2,1B8
02800 JRST DOIEOF ;YEP
02900 SETZ D,
03000 JRST DOB7
03100
03200 DOIEOF: SETOM .SKIP.
03300 SKIPE ENDFL(CDB) ;SPECIFIED?
03400 SETOM @ENDFL(CDB) ;YES
03500 AOS -2(P)
03600 DOB7: AOS -2(P)
03700 DORET: POP P,2
03800 POP P,1
03900 POPJ P,
04000
04100
04200 DOBUFF:
04300 PUSHJ P,ADCI
04400 JRST DOIEOF ;INDICATE EOF
04500 JRST DORET
04600
04700 BEND DOINP
00100 DSCR ADCO,ADCO1
00200 CAL PUSHJ
00300 SID SAVES ALL ACS
00400 ARGS
00500 1 JFN
00600 CDB address of channel data block
00700 ⊗
00800
00900 BEGIN ADCO
01000 ;HERE IF THE COUNT ALREADY PROMISES A CHARACTER
01100 ↑↑ADCO1:
01200 AOS IOCNT(CDB) ;MAKE THE COUNT HONEST, TEMPORARILY
01300 PUSHJ P,ADCO ;CALL ADCO
01400 SOS IOCNT(CDB) ;REFLECT THE FACT THAT A CHARACTER IS PROMISED
01500 POPJ P, ;AND RETURN (TO CHARACTER OUTPUT CODE)
01600
01700 ↑↑ADCO:
01800 PUSH P,2 ;SAVE ACS
01900 PUSH P,3
02000 PUSH P,4
02100 MOVE 2,IOSTT(CDB) ;GET STATUS
02200 CAIE 2,XOCHAR ;PMAPPING THE DSK?
02300 JRST NOPMAP ;GUESS NOT
02400 AOS 2,IOPAGE(CDB) ;NEXT PAGE
02500 PUSHJ P,SETPAGE
02600 MOVEI 2,1000*5
02700 MOVEM 2,IOCNT(CDB) ;CAN WRITE THIS MANY
02800 MOVE 2,IOADDR(CDB)
02900 HRLI 2,440700
03000 MOVEM 2,IOBP(CDB) ;OK
03100 ADRET: POP P,4
03200 POP P,3
03300 POP P,2
03400 POPJ P,
03500
03600
03700 NOPMAP:
03800 CAIN 2,XCOCHAR ;36-BIT ETC.?
03900 JRST STRSOU ;USE SOUT
04000 CAIE 2,XDICHAR ;BETTER BE DUMP-MODE
04100 ERR <Dryrot at ADCO>,1
04200 MOVE 3,IOADDR(CDB)
04300 MOVEI 4,DMOCNT*5
04400 CAMG 4,IOCNT(CDB) ;ANY CHARS TO SEND
04500 JRST ADRET
04600
04700 MOVEI 2,3
04800 SUBI 3,1
04900 MOVNI 4,DMOCNT ;WORD COUNT FOR DUMP MODE OUTPUT
05000 HRL 3,4 ;MAKE AN IOWD
05100 SETZ 4, ;MAKE A COMMAND LIST
05200 JSYS DUMPO
05300 ERR <DUMPOUT: CANNOT WRITE DATA IN DUMP MODE>,1
05400 SETOM DMPED(CDB) ;AND INDICATE DONE
05500 DMPINIT:
05600 MOVE 3,IOADDR(CDB)
05700 HRL 2,3
05800 HRRI 2,1(3)
05900 SETZM (3)
06000 BLT 2,DMOCNT-1(3) ;ZERO OUT
06100 MOVEI 2,DMOCNT*5
06200 MOVEM 2,IOCNT(CDB) ;SAVE COUNT
06300 HLL 3,[POINT 7,0,-1];FIX A BYTE-POINTER
06400 MOVEM 3,IOBP(CDB) ;AND SAVE BYTE-POINTER
06500 JRST ADRET
06600
06700 STRSOU:
06800 MOVEI 3,1000*5
06900 SUB 3,IOCNT(CDB) ;NUMBER OF CHARACTERS ACTUALLY IN BUFFER
07000 IDIVI 3,5 ;NUMBER OF WORDS
07100 SKIPE 4 ;ANY REMAINDER?
07200 AOJ 3, ;YES, ANOTHER WORD FOR EXTRA CHARACTERS
07300 JUMPE 3,ADRET ;RETURN IF NO CHARACTERS TO SEND
07400 MOVN 3,3 ;NEGATIVE WORD COUNT FOR SOUT
07500 MOVE 2,IOADDR(CDB)
07600 HRLI 2,444400 ;MAKE A BP
07700 JSYS SOUT
07800 SOUINIT:
07900 MOVE 2,IOADDR(CDB)
08000 HRL 3,2
08100 HRRI 3,1(2)
08200 SETZM (2)
08300 BLT 3,777(2) ;CLEAR OUT PAGE
08400 HRLI 2,440700
08500 MOVEM 2,IOBP(CDB)
08600 MOVEI 3,1000*5
08700 MOVEM 3,IOCNT(CDB)
08800 JRST ADRET
08900
09000 BEND ADCO
00100 DSCR SETIO
00200 Master routine to set up the file io possibilities.
00300
00400 Arguments:
00500 1,CHNL,CDB set up
00600
00700 There are four entries to the function, depending on the kind of IO that
00800 appears to be desired. They are:
00900
01000 SETCI character input
01100 SETCO character output
01200 SETWI word input
01300 SETWO word output
01400
01500
01600 This routine does the following things:
01700 (1) sets up IOSTT
01800
01900
02000 It does so by first deciding each of these
02100 (1) input or output immediately desired
02200 (2) chars or words immediately desired
02300 (3) 7 or 36 bit bytes open
02400 (4) mode 0 or 17
02500 (5) dsk or non-dsk
02600
02700 An additional consideration is that the file, if on the disk,
02800 may need to be CLOSFed and reOPENFed to allow reading (and writing
02900 if appending).
03000 This facilitates (indeed, makes possible) PMAPping the file and
03100 doing I/O directly into pages of the file. Should this reOPENF
03200 fail (as when protection does not allow it), it will be necessary
03300 to restrict the possibility of doing data mixed and random I/O
03400 to the file. Such is the design of TENEX. (Example: MESSAGE.TXT
03500 is ordinarily such that you can append to it but not read and
03600 write, when it is someone else's file.)
03700 ⊗
03800
03900 BEGIN SETIO
04000 ↑SETWI: SKIPA 6,[=8] ;wants word input
04100 ↑SETWO: MOVEI 6,=24 ;wants word output
04200 JRST SETIO ;
04300
04400 ↑SETCI: TDZA 6,[-1] ;wants character input
04500 ↑SETCO: MOVEI 6,=16 ;wants character output
04600
04700 SETIO: LDB 2,[POINT 6,OFL(CDB),5] ;7-36 BIT BYTES?
04800 CAIN 2,=36
04900 ADDI 6,4 ;36
05000 LDB 2,[POINT 4,OFL(CDB),9]
05100 JUMPE 2,.+2 ;MODE 0 OR 17?
05200 ADDI 6,2 ;17
05300 SKIPE DVTYP(CDB) ;DSK OR NON-DSK?
05400 AOJ 6, ;NON-DSK
05500 IDIVI 6,7 ;SET UP FOR LDB
05600 LDB 6,BPS(7)
05700 JUMPN 6,.+2
05800 ERR <DRYROT at SETIO: Nonsense combination of bytes and modes for io request.>,1
05900 MOVEM 6,IOSTT(CDB) ;THAT IS THE ANSWER
06000 CAIL 6,XICHAR ;PMAPPED DISK FILE?
06100 CAILE 6,XOWORD
06200 JRST NOPMAP
06300 MOVE 2,OFL(CDB)
06400 TESTN 2,WRBIT ;WRITING
06500 TESTE 2,APPBIT ;OR APPENDING?
06600 JRST .+2 ;THEN BETTER BE READING
06700 JRST CHKED1
06800 TESTO 2,RDBIT ;MUST BE READING
06900 TESTN 2,APPBIT ;REMEMBER IF APPENDING
07000 JRST NOAPP ;NOT APPENDING
07100 TESTZ 2,APPBIT ;TURN OFF APPENDING
07200 TESTO 2,WRBIT ;INDICATE WRITING
07300 SKIPA 3,[-1] ;APPENDING
07400 NOAPP: SETZ 3, ;NOT APPENDING
07500 CAMN 2,OFL(CDB) ;DIFFERENT?
07600 JRST CHKED ;NO
07700 TESTO 1,1B0 ;DONT RELEASE
07800 JSYS CLOSF
07900 ERR <SETIO: Cannot do CLOSF>
08000 TESTZ 1,1B0 ;RESET DONT RELEASE BIT
08100 PUSH P,1 ;SAVE JFN
08200 JSYS OPENF
08300 JRST NOROPN ;CANNOT RE-OPEN FILE
08400 POP P,1 ;RESTORE JFN
08500 MOVEM 2,OFL(CDB) ;AND REMEMBER NEW FLAGS
08600 CHKED: SKIPA 2,3 ;PICK UP SAVED POINTER
08700 CHKED1: SETZ 2,
08800 PUSH P,2 ;SAVE POINTER
08900 SETOM IOPAGE(CDB) ;DENY THAT THERE IS A PAGE THERE
09000 MOVE 2,[XWD 2,11] ;READ FDB
09100 MOVEI 3,2
09200 JSYS GTFDB
09300 MOVEM 3,FDBEOF(CDB) ;SAVE EOF
09400 LDB 2,[POINT 6,2,11]
09500 MOVEM 2,FDBSZ(CDB)
09600 POP P,2 ;GET POINTER BACK
09700 CAIE 6,XIWORD ;SEE IF WORDS
09800 CAIN 6,XOWORD
09900 JRST SETWPT ;WORDS POPJ BACK
10000 JRST SETCPT ;CHARACTERS POPJ BACK
10100
10200 NOROPN: POP P,1 ;CLOBBERED JFN
10300 MOVE 2,OFL(CDB) ;FLAGS AS THEY WERE -- CANT DO NO BETTER
10400 JSYS OPENF
10500 ERR <SETIO: Cannot do OPENF>
10600 MOVE 2,IOSTT(CDB) ;STATUS -- MUST BE CHANGED
10700 CAIN 2,XICHAR
10800 MOVEI 3,XCICHAR
10900 CAIN 2,XOCHAR
11000 MOVEI 3,XCOCHAR
11100 CAIE 2,XIWORD
11200 CAIN 2,XOWORD
11300 MOVEI 3,XCIWORD
11400 MOVEM 3,IOSTT(CDB) ;SAVE STATUS -- BEST WE CAN DO
11500 ;FALL THRU AND RETURN
11600 NOPMAP: SETZM IOCNT(CDB)
11700 SETZM IOBP(CDB)
11800 POPJ P,
11900
12000
12100 BPS: POINT 5,TABL(6),4 ;BYTE POINTERS
12200 POINT 5,TABL(6),9
12300 POINT 5,TABL(6),14
12400 POINT 5,TABL(6),19
12500 POINT 5,TABL(6),24
12600 POINT 5,TABL(6),29
12700 POINT 5,TABL(6),34
12800
12900 TABL: BYTE (5) XBYTE7,XBYTE7,0,0,XICHAR,XCICHAR,XDICHAR
13000 BYTE (5) XDICHAR,0,0,0,0,XIWORD,XCIWORD
13100 BYTE (5) XDARR,XDARR,XBYTE7,XBYTE7,0,0,XOCHAR
13200 BYTE (5) XCOCHAR,XDOCHAR,XDOCHAR,0,0,0,0
13300 BYTE (5) XOWORD,XOWORD,XDARR,XDARR
13400
13500
13600 BEND SETIO
00100 DSCR
00200 FINIO
00300
00400 Finishes the io.
00500 Mainly does the following:
00600
00700 (1) outputs any remaining buffers
00800 (2) checks eof pointer in FDB of dsk files
00900 (3) writes EOF marks to magtape
01000
01100 CAL PUSHJ from runtimes (CFILE and CLOSF)
01200 ARGS 1,CDB
01300 SID nothing saved
01400 ⊗
01500 HERE(FINIO)
01600 BEGIN FINIO
01700 PUSH P,1
01800 PUSH P,2
01900 PUSH P,3
02000 PUSH P,4
02100 PUSH P,5
02200 PUSH P,6
02300 SIMIO 2,TABL,POPBACK
02400 UNMAP: SETZM DMPED(CDB) ;RESET VALUES TO ORIGINALS
02500 SETZM IOCNT(CDB)
02600 SETZM IOBP(CDB)
02700 SETZM IOSTT(CDB)
02800 SETOM IOPAGE(CDB) ;N.B.
02900 SETO 1, ;DESTROY PAGE -- NOTE: CLOBBERS JFN
03000 MOVE 2,FKPAGE(CDB) ;UNTIL POP BELOW
03100 SETZ 3,
03200 JSYS PMAP
03300 POPBACK:POP P,6
03400 POP P,5
03500 POP P,4
03600 POP P,3
03700 POP P,2
03800 POP P,1
03900 POPJ P,
04000
04100 TABL: JRST POPBACK ;0 -- XNULL
04200 JFCL ;1 -- XICHAR
04300 PUSHJ P,CHCEOF ;2 -- XOCHAR -- POPJ RETURN
04400 JFCL ;3 -- XIWORD
04500 PUSHJ P,CHWEOF ;4 -- XOWORD
04600 JFCL ;5 -- XCICHAR
04700 PUSHJ P,ADCO ;6 -- XCOCHAR
04800 JFCL ;7 -- XCWORD
04900 JFCL ;10 -- XBYTE7
05000 JFCL ;11 -- XDICHAR
05100 JRST XDO1 ;12 -- XDOCHAR
05200 JRST XDO2 ;13 -- XDARR
05300
05400
05500 XDO1: PUSHJ P,ADCO ;WRITE OUT WHATEVER IS THERE
05600 XDO2: SKIPN DMPED(CDB) ;DUMP MODE OUTPUT SEEN?
05700 JRST UNMAP ;NOPE
05800 MOVE 2,DVTYP(CDB) ;DEVICE TYPE
05900 CAIE 2,2 ;MAGTAPE?
06000 JRST UNMAP ;NOPE
06100 MOVEI 2,3 ;EOF
06200 JSYS MTOPR ;WRITE TWO
06300 JSYS MTOPR
06400 MOVEI 2,17 ;BACKSPACE OVER 1 EOF
06500 JSYS MTOPR
06600 JRST UNMAP
06700
06800
06900 BEND FINIO
00100 ENDCOM(IOROU)
00200
00300 COMPIL(BINROU,<SFPTR,RFPTR,MTOPR,BKJFN,RFBSZ>
00400 ,<SAVE,RESTR,X22,X33,X44,.SKIP.,JFNTBL,CDBTBL>
00500 ,<BINROU -- Binary routines generally to not be used>)
00600
00100 DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
00200 Sets the file open on JFN to byte POINTER (-1 for EOF).
00300 Errors returned in .SKIP.
00400 WARNING: presently not compatible with special character
00500 mode.
00600 ⊗
00700 HERE(SFPTR)
00800 PUSHJ P,SAVE
00900 MOVE LPSA,X33
01000 VALCHN 1,-2(P),SFBAD
01100 SETZM .SKIP.
01200 MOVE 2,-1(P)
01300 JSYS SFPTR
01400 MOVEM 1,.SKIP.
01500 SFRET: JRST RESTR
01600
01700 SFBAD: ERR <Illegal JFN>,1
01800 SETOM .SKIP.
01900 JRST SFRET
02000
02100
00100 DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
00200 Reads the pointer of JFN. Error codes to .SKIP.
00300 WARNING: presently does not work for files in special character
00400 mode.
00500 ⊗
00600 HERE(RFPTR)
00700 PUSHJ P,SAVE
00800 MOVE LPSA,X22
00900 VALCHN 1,-1(P),RFBAD
01000 SETZM .SKIP.
01100 JSYS RFPTR
01200 MOVEM 1,.SKIP.
01300 MOVEM 2,RACS+A(USER) ;ANSWER IN 2
01400 RFRET: JRST RESTR
01500
01600 RFBAD: ERR <Illegal JFN>,1
01700 SETOM .SKIP.
01800 JRST RFRET
01900
00100 DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
00200 Does the MTOPR jsys.
00300 ⊗
00400 HERE(MTOPR)
00500 BEGIN MTOPR
00600 PUSHJ P,SAVE
00700 MOVE LPSA,X44
00800 VALCHN 1,-3(P),MTBAD
00900 MOVE 2,-2(P)
01000 MOVE 3,-1(P)
01100 JSYS MTOPR
01200 MTRET: JRST RESTR
01300
01400 MTBAD: ERR <Illegal JFN>,1
01500 JRST MTRET
01600
01700 BEND MTOPR
01800
00100 DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
00200 Does the BKJFN jsys on JFN, error code to .SKIP.
00300 ⊗
00400 HERE(BKJFN)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),BKBAD
00800 SETZM .SKIP.
00900 BKJF1: JSYS BKJFN
01000 MOVEM 1,.SKIP. ;ERROR RETURN
01100 BKRET: JRST RESTR
01200
01300 BKBAD: MOVE 1,-1(P) ;USE LITERALLY
01400 JRST BKJF1
00100 DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
00200 Reads the byte-size of the file open on JFN.
00300 ⊗
00400 HERE(RFBSZ)
00500 PUSHJ P,SAVE
00600 MOVE LPSA,X22
00700 VALCHN 1,-1(P),RFBBAD
00800 JSYS RFBSZ
00900 MOVEM 2,RACS+A(USER) ;ANSWER IN 2
01000 RFBRET: JRST RESTR
01100
01200 RFBBAD: ERR <Illegal JFN>,1
01300 JRST RFBRET
01400
01500 ENDCOM(BINROU)
01600
00100 IMSSS,<
00200 COMPIL(DSKOPS,<DSKIN,DSKOUT>
00300 ,<JFNTBL,CDBTBL,.SKIP.>
00400 ,<DSKOPS -- DIRECT DSK ROUTINES>)
00500
00600 DSCR SIMPLE PROCEDURE
00700 DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);
00800
00900 IMSSS only.
01000 Does direct IO from the DSK (formerly device "PAK").
01100 Modules 4-7 are legal for everyone. Other modules require enabled
01200 status.
01300 Count words are read into user's core at location LOC, from
01400 MODULE, record RECNO. Error bits are in .SKIP.
01500 Does the DSKOP jsys (as modified at IMSSS).
01600 ⊗
01700
01800 BEGIN DSKOPS
01900 HERE(DSKIN)
02000 PUSHJ P,SAVE
02100 SETZ 4, ;INDICATE READ ONLY
02200
02300 DSK1: HRRZ 2,-2(P)
02400 JUMPLE 2,DSBAD ;LEQ 0 -- ERROR
02500 CAILE 2,1000 ;DONT READ MORE THAN 1000 WORDS
02600 JRST DSBAD
02700 IOR 2,4 ;PICK UP READ OR WRITE (SET IN 4)
02800 HRLZ 1,-4(P) ;MODULE
02900 HRR 1,-3(P) ;RECORD NO. IN RIGHT HALF
03000 TLO 1,600000 ;SOFTWARD ADDRESS, IMSSS FORMAT (BITS 0 AND 1 RES.)
03100 HRRZ 3,-1(P) ; GET THE USER LOCATION
03200 JSYS DSKOP
03300 DSDUN: MOVEM 1,.SKIP. ; SAVE ERROR BITS
03400 DSRET: MOVE LPSA,[XWD 5,5] ; TO ADJUST STACK
03500 JRST RESTR
03600 DSBAD: ERR <DSKIN OR DSKOUT: WORD COUNT EITHER <= 0 OR > '1000>,1
03700 SETOM .SKIP.
03800 JRST DSRET
03900
04000
04100
00100 DSCR SIMPLE PROCEDURE
00200 DSKOUT(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC)
00300 DESR Similar to DSKIN, except that a write is done.
00400 ⊗
00500
00600 HERE(DSKOUT)
00700 PUSHJ P,SAVE
00800 MOVSI 4,(1B14) ;INDICATE WRITE (TO BE IOR'ED INTO AC 2)
00900 JRST DSK1 ;AND TO THE ABOVE CODE
01000
01100 BEND DSKOPS
01200
01300 ENDCOM(DSKOP)
01400 >;IMSSS
01500
00100 COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
00200 ,<X22,X44,.SKIP.,JFNTBL,CDBTBL>
00300 ,<DEVS -- DEVICE HANDLERS, ERROR ROUTINE>)
00400 DSCR INTEGER SIMPLE PROCEDURE DEVTYPE(INTEGER JFN);
00500 Returns (via the DEVCHR jsys) the device type of
00600 the device open on JFN. The more general DEVCHR call is
00700 also implemented (below).
00800 ⊗
00900 HERE(DEVTYPE)
01000 VALCHN 1,-1(P),DEVBAD
01100 JSYS DVCHR
01200 HLRZ 1,2
01300 ANDI 1,777
01400 DEVRET: SUB P,X22
01500 JRST @2(P)
01600 DEVBAD: ERR <Illegal JFN>,1
01700 JRST DEVRET
00100 DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN; REFERENCE INTEGER AC1,AC3);
00200 Does the DEVCHR jsys, returning the flags from AC2 as the
00300 value of the call, and AC1 and AC3 get the contents of ac's 1 and 3.;
00400 ⊗
00500 HERE(DVCHR)
00600 VALCHN 1,-3(P),DVBAD
00700 JSYS DVCHR
00800 MOVEM 1,@-2(P)
00900 MOVEM 3,@-1(P)
01000 MOVE 1,2
01100 DVRET: SUB P,X44
01200 JRST @4(P)
01300 DVBAD: ERR <Illegal JFN>,1
01400 JRST DVRET
01500
01600
00100 DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
00200 Using the ERSTR jsys, types out on the console the TENEX error string
00300 associated with ERRNO for FORK fork (0 for the current fork). Parameters (in
00400 the sense of the ERSTR jsys) are expanded.
00500 Types out the string ERSTR: UNDEFINED ERROR number if
00600 something is with your error number or fork (and sets .SKIP. to -1).
00700 ⊗
00800 HERE(ERSTR)
00900 SETZM .SKIP.
01000 MOVEI 1,101 ;PRIMARY OUTPUT
01100 SKIPN 2,-1(P) ;ANY FORK MENTIONED?
01200 MOVEI 2,400000 ;ASSUME CURRENT FORK
01300 HRLZ 2,2 ;IN LEFT HALF
01400 HRR 2,-2(P) ;THE ERROR NUMBER
01500 SETZ 3, ;NO LIMIT TO SIZE OF STRING
01600 JSYS ERSTR
01700 JRST ERSERR
01800 JRST ERSERR ;ERROR RETURNS
01900 ERSRET: SUB P,X33
02000 JRST @3(P)
02100 ERSERR: HRROI 1,[ASCIZ/
02200 ERSTR: UNDEFINED ERROR NUMBER
02300 /]
02400 JSYS PSOUT
02500 SETOM .SKIP. ;INDICATE ERROR
02600 JRST ERSRET
02700 ENDCOM(DEVS)
02800
00100 COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET>
00200 ,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC,INSET>
00300 ,<UTILITY -- UTILITY TENEX ROUTINES>)
00400 DSCR
00500 SETCHN accepts in A the JFN, and returns in A the channel number associated with a JFN.
00600 It sets up the JFNTBL, the CDBTBL table, and returns the address of the
00700 file command block in ac CDB. Other acs are not modified (except USER).
00800 In order to accommodate the OPEN statement, a channel will be
00900 considered allocated when it has a CDB, even if it does not yet have a jfn.
01000 ⊗
01100
01200 HERE(SETCHN)
01300 MOVE USER,GOGTAB
01400 PUSH P,B
01500 PUSH P,C
01600 PUSH P,D
01700 MOVEI B,JFNSIZE ;FOR COMPARISON TO RH OF A
01800 CAILE B,(A) ;IS THE JFN BEYOND THE NUMBER OF CHANNELS
01900 SKIPE CDBTBL(A) ;OR IS IT ALLOCATED OR USED?
02000 JRST FNDCHN ;PERHAPS NOT, FIND ONE SOMEHOW
02100 HRRZ D,A ;USE JFN NO. AS CHANNEL
02200 ;MUST GET A CHANNEL DATA BLOCK
02300 GTCDB: MOVEI C,IOTLEN
02400 PUSHJ P,CORGET
02500 ERR <SETCHN: NO CORE>
02600 MOVE CDB,B
02700 MOVEM CDB,CDBTBL(D) ;SAVE ADDR OF CDB
02800 ;HERE WITH B,CDB, D LOADED WITH: CDBADDR,CDBADDR,CHANNEL
02900 CLCDB:
03000 HRL B,B
03100 ADDI B,1
03200 SETZM (CDB)
03300 BLT B,IOTLEN-1(CDB)
03400
03500 GOTCHN:
03600 MOVEM A,JFNTBL(D)
03700 HRRZ 1,A ;JFN
03800 JSYS DVCHR ;CLOBBERS 1,2,3
03900 MOVEM 1,DVDSG(CDB) ;SAVE DESIGNATOR
04000 MOVEM 2,DVCH(CDB) ;AND CHARACTERISTICS
04100 HLRZ 1,2
04200 ANDI 1,777 ;GET DEVICE TYPE
04300 MOVEM 1,DVTYP(CDB) ;AND SAVE IT
04400 MOVEI 2,STARTPAGE(D) ;PAGE FOR BUFFER
04500 HRLI 2,400000 ;THIS FORK
04600 MOVEM 2,FKPAGE(CDB) ;XWD FORK,PAGE FOR PMAPPING
04700 LSH 2,9 ;MAKE AN ADDRESS
04800 MOVEM 2,IOADDR(CDB) ;AND SAVE IT AS WELL
04900 SETOM IOPAGE(CDB) ;DENY THAT THERE IS A PAGE THERE
05000 HRRZ A,D ;CHANNEL INTO A
05100 POP P,D ;RESTORE
05200 POP P,C
05300 POP P,B
05400 POPJ P,
05500
05600
05700 ;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
05800 ;A HAS THE JFN NO. IN IT, SO CHECK TO SEE IF THE SAME
05900 ;B MAY BE CLOBBERED
06000 FNDCHN: HRRZ D,JFNTBL(A) ;CHECK OLD JFN
06100 CAIE D,(A) ;SAME AS THE NEW?
06200 JRST FNDCH2 ;NO
06300 MOVE CDB,CDBTBL(D) ;GET OLD CDB
06400 MOVE B,CDB ;COPY CDB ADDR FOR BLT
06500 JRST CLCDB
06600
06700 FNDCH2: SETZ D,
06800 FNDCH1: CAIL D,JFNSIZE
06900 ERR <SETCHN: JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
07000 SKIPE CDBTBL(D) ;IS IT EMPTY?
07100 AOJA D,FNDCH1 ;NO LOOK SOME MORE
07200 JRST GTCDB ;YES, USE IT
07300
07400
07500 DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);
07600
07700 Internal book-keeping routine not intended for
07800 use from SAIL. Causes liberation from SAIL.
07900
08000 THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
08100 THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
08200 ⊗
08300
08400 HERE(ZSETST)
08500 MOVE USER,GOGTAB ; GET USER
08600 SKIPE SGLIGN(USER)
08700 PUSHJ P,INSET ;ASSUMING THAT IT IS TRANSPARENT FOR THE ACS
08800 MOVE 1,-1(P) ;GET EXPECTED LENGTH
08900 ADDM 1,REMCHR(USER) ; ADD ON
09000 SKIPLE REMCHR(USER) ; NEED TO COLLECT?
09100 PUSHJ P,GOCOLLECT ; YES
09200 MOVE 1,TOPBYTE(USER) ; RETURN BP
09300 SUB P,X22 ; ADJUST STACK
09400 JRST @2(P) ; RETURN
09500
09600 GOCOLLECT:
09700 MOVEM RF,RACS+RF(USER) ;SAVE RF
09800 PUSHJ P,STRNGC ;
09900 POPJ P, ; RETURN TO ABOVE
10000
00100 DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
00200 Internal book-keeping routine.
00300 ADJUSTS THE PARAMETERS ASSOCIATED WITH STRING SPACE.
00400 BP IS OUR NEW TOPBYTE. CNTEST IS THE COUNT ESTIMATE WE
00500 ORIGINALLY MADE.
00600 FIRST, WE MUST MAKE REMCHR HONEST, THEN WE
00700 CAN FIX TOPSTR AND THE USER'S LENGTH WORD.
00800 ⊗
00900 HERE(ZADJST)
01000 BEGIN ZADJST
01100
01200
01300 MOVE USER,GOGTAB;
01400 PUSH P,1
01500 PUSH P,2
01600 PUSH P,3
01700 PUSH P,4
01800
01900 DEFINE CNTARG <-6(P)>
02000 DEFINE BPARG <-5(P)>
02100
02200 MOVE 2,BPARG ;UPDATED BP
02300 MOVE 1,TOPBYTE(USER) ; GET OLD TOPBYTE
02400 CAMN 1,2 ; THE NULL STRING?
02500 JRST NULRET; ;YES
02600 ;P. KANERVA'S BYTE ROUTINE
02700 LDB 3,[POINT 6,1,5] ;BITS TO THE RIGHT OF BYTE 1
02800 LDB 4,[POINT 6,2,5] ;BITS TO THE RIGHT OF BYTE 2
02900 SUBI 3,(4) ;BIT DIFFERENCE
03000 IDIVI 3,7 ;WITHIN-WORD BYTE DIFFERENCE
03100
03200 SUBI 2,(1) ;WORDS BETWEEN BYTES
03300 HRRE 2,2 ;FULL WORD DIFFERENCE
03400 IMULI 2,5 ;CONVERT IT TO BYTE DIFFERENCE
03500 ADD 2,3 ;ADD COUNT DERIVED FROM WITHIN-WORD
03600 ;DIFFERENCE
03700
03800 CAMLE 2,CNTARG ;WITHIN RANGE?
03900 ERR <ZADJST: TENEX WROTE TOO LONG A STRING, MAY BE FATAL>,1
04000 GOTLNG: HRRO 1,2 ; XWD -1,COUNT
04100 PUSH SP,1 ; XWD -1,COUNT
04200 PUSH SP,TOPBYTE(USER) ; OLD TOPBYTE FOR BP FOR STRING
04300 JUMPE 2,NOLNG
04400 MOVE 1,BPARG
04500 MOVEM 1,TOPBY∃E(USER)
04600 NOLNG:
04700 SUB 2,CNTARG ; SUBTRACT THE COUNT ESTIMATE
04800 ADDM 2,REMCHR(USER) ; MAKE REMCHR HONEST
04900 POP P,4
05000 POP P,3
05100 POP P,2
05200 POP P,1
05300 SUB P,X33 ; ADJUST STACK
05400 JRST @3(P) ;
05500
05600 NULRET: SETZ 2,;
05700 JRST GOTLNG ; BE SURE TO FIX UP ALL THE GOODIES
05800
05900 BEND ZADJST
06000
00100 DSCR
00200 .RESET
00300 SID SAVES ALL ACS
00400 CAL JSP P,.RESET from SAILOR
00500
00600 RESETS TENEX IO AND BOOKKEEPING, AND SETS THE TTY MODE TO WAKEUP
00700 ON EVERY CHARACTER. TTY WAKEUP IS NOT DONE IF THE JOB IS DETACHED.
00800 THIS SHOULD ONLY BE CALLED FROM SAILOR.
00900 ⊗
01000 HERE(.RESET)
01100 BEGIN RESET
01200 ;ZERO OUT BOOKKEEPING
01300 SETZM JFNTBL
01400 MOVE 1,[XWD JFNTBL,JFNTBL+1]
01500 BLT 1,JFNTBL+JFNSIZE-1
01600 SETZM CDBTBL
01700 MOVE 1,[XWD CDBTBL,CDBTBL+1]
01800 BLT 1,CDBTBL+JFNSIZE-1
01900
02000 ;RELEASE PAGES ASSOCIATED WITH FILES (FROM STARTPAGE TO STARTPAGE+JFNSIZE-1)
02100 SETO 1, ;RELEASE PAGE
02200 SETZ 3, ;FLAGS WORD
02300 MOVE 2,[XWD 400000,STARTPAGE]
02400 .RESE1: CAMN 2,[XWD 400000,STARTPAGE+JFNSIZE] ;THIS WOULD BE TOO MANY PAGES
02500 JRST .RESE2
02600 JSYS PMAP
02700 AOJA 2,.RESE1 ;NEXT?
02800
02900 .RESE2:
03000 JSYS RESET ;CLEAR ALL IO
03100
03200 ;SET UP PSI SYSTEM
03300 HRRZI 1,400000 ;USE EXISTING TABLE IF THERE
03400 JSYS RIR
03500 JUMPN 2,.+3 ;ALREADY THERE
03600 MOVE 2,[XWD LEVTAB,CHNTAB]
03700 JSYS SIR
03800 JSYS EIR ;TURN ON INTERRUPTS
03900
04000 ;CHECK AND SEE IF WE ARE DETACHED
04100 JSYS GJINF
04200 CAMN 4,[-1] ;-1 FOR DETACHED JOBS
04300 JRST DTCHED ;YES IT IS DETACHED
04400
04500 ;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
04600 ;THE USER MAY RESET THIS.
04700 MOVEI 1,100 ;PRIMARY INPUT
04800 JSYS RFMOD
04900 TRO 2,170000 ;WAKEUP ON ALL CHARS
05000 JSYS SFMOD
05100 DTCHED: SETZM CTLOSW ;CLEAR OUTPUT-SUPPRESSION SWITCH
05200
05300 JRST (P) ;AND RETURN
05400 BEND RESET
05500
05600 ;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
05700 ;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
05800 ;MUST BE AVAILABLE FOR RE-OPENING)
05900 ;ARGS:
06000 ; 1 JFN
06100 ; CDB THE CHANNEL DATA BLOCK
06200 ↑OPNCHK:
06300 SKIPL IOSTT(CDB) ;CLOSED BY DEC?
06400 POPJ P, ;NO
06500 PUSH P,2 ;SAVE 2
06600 MOVE 2,OFL(CDB) ;PREVIOUSLY USED FLAGS
06700 JSYS OPENF ;OPEN
06800 ERR <OPNCHK: Cannot OPENF file>,1
06900 SETZM IOSTT(CDB)
07000 POP P,2 ;RESTORE 2
07100 POPJ P, ;RETURN
07200
07300 ENDCOM(UTILITY)
00100 COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP>
00200 ,<SAVE,RESTR,X22,X33,X44>
00300 ,<TTM -- TERMINAL MODE ROUTINES>)
00400
00500 DSCR INTEGER PROCEDURE RFMOD(INTEGER CHAN)
00600
00700 Reads a file's mode word.
00800
00900 PROCEDURE SFMOD(INTEGER CHAN,AC2)
01000
01100 Sets a file's mode word to argument AC2.
01200
01300 PROCEDURE STPAR(INTEGER CHAN,BITS)
01400
01500 Executes the STPAR jsys on CHAN with arguments BITS
01600
01700 PROCEDURE STI(INTEGER CHAN,CHAR)
01800
01900 Executes the STI jsys on CHAN with character CHAR.
02000
02100 PROCEDURE RFCOC(INTEGER CHAN; REFERENCE INTEGER AC2,AC3)
02200
02300 Does RFCOC jsys, returning values in AC2 and AC3.
02400
02500 PROCEDURE SFCOC(INTEGER CHAN,AC2,AC3)
02600
02700 Does SFCOC jsys, setting to AC2 and AC3.
02800
02900 INTEGER PROCEDURE GTTYP(INTEGER CHAN; REFERENCE INTEGER BUFS)
03000
03100 Does GTTYP jsys on CHAN/TTY and returns the
03200 typ information as the value of the call. BUFS is the
03300 result from AC 3.
03400
03500 PROCEDURE STTYP(INTEGER CHAN,NEWTYPE)
03600
03700 Sets the terminal type of CHAN to NEWTYPE
03800
03900 ⊗
04000
04100 HERE(RFMOD)
04200 PUSHJ P,SAVE
04300 MOVE LPSA,X22
04400 VALCH1 1,-1(P),RFMO1
04500 RFMO2: JSYS RFMOD
04600 MOVEM 2,RACS+A(USER)
04700 JRST RESTR
04800 RFMO1: MOVE 1,-1(P) ;USE LITERALLY
04900 JRST RFMO2
05000
05100
05200
05300 HERE(SFMOD)
05400 PUSHJ P,SAVE
05500 MOVE LPSA,X33
05600 VALCH1 1,-2(P),SFMO1
05700 SFMO2: MOVE 2,-1(P)
05800 JSYS SFMOD
05900 JRST RESTR
06000 SFMO1: MOVE 1,-2(P)
06100 JRST SFMO2
06200
06300 HERE(STPAR)
06400 PUSHJ P,SAVE
06500 MOVE LPSA,X33
06600 VALCH1 1,-2(P),STPAR1
06700 STPAR2: MOVE 2,-1(P) ;PARAMETERS TO SET
06800 JRST RESTR
06900 STPAR1: MOVE 1,-2(P) ;USE LITERALLY
07000 JRST STPAR2
07100
07200 HERE(STI)
07300 PUSHJ P,SAVE
07400 MOVE LPSA,X33
07500 VALCH1 1,-2(P),STI1
07600 STI2: MOVE 2,-1(P)
07700 JSYS STI
07800 JRST RESTR
07900 STI1: MOVE 1,-2(P) ;USE LITERALLY
08000 JRST STI2
08100
08200
08300 HERE(RFCOC)
08400 PUSHJ P,SAVE
08500 MOVE LPSA,X44
08600 VALCH1 1,-3(P),RFCO1
08700 RFCO2: JSYS RFCOC
08800 MOVEM 2,@-2(P)
08900 MOVEM 3,@-1(P)
09000 JRST RESTR
09100 RFCO1: MOVE 1,-3(P) ;USE LITERALLY
09200 JRST RFCO2
09300
09400 HERE(SFCOC)
09500 PUSHJ P,SAVE
09600 MOVE LPSA,X44
09700 VALCH1 1,-3(P),SFCO1
09800 SFCO2: MOVE 2,-2(P)
09900 MOVE 3,-1(P)
10000 JSYS SFCOC
10100 JRST RESTR
10200 SFCO1: MOVE 1,-3(P) ;USE LITERALLY
10300 JRST SFCO2
10400
10500 HERE(GTTYP)
10600 PUSHJ P,SAVE
10700 MOVE LPSA,X33
10800 VALCH1 1,-2(P),GTTYP1
10900 GTTYP2: JSYS GTTYP
11000 MOVEM 2,RACS+A(USER) ;TERMINAL TYPE NUMBER FOR RETURN
11100 MOVEM 3,@-1(P) ;XWD INBUFS, OUTBUFS
11200 JRST RESTR
11300 GTTYP1: MOVE 1,-2(P) ;USE LITERALLY
11400 JRST GTTYP2
11500
11600 HERE(STTYP)
11700 PUSHJ P,SAVE
11800 MOVE LPSA,X33
11900 VALCH1 1,-2(P),STTYP1
12000 STTYP2: MOVE 2,-1(P) ;NEW TERMINAL TYPE
12100 JSYS STTYP
12200 JRST RESTR
12300 STTYP1: MOVE 1,-2(P) ;USE LITERALLY
12400 JRST STTYP2
12500
12600 ENDCOM(TTM)
12700
00100 COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
00200 ,<PAGES -- PAGE MANAGEMENT>)
00300 DSCR SIMPLE PROCEDURE PMAP(INTEGER AC1,AC2,AC3);
00400 DESR
00500 Does the PMAP jsys, with these parameters:
00600
00700 ARGUMENTS:
00800 AC1 contents of AC1
00900 AC2 " of AC2
01000 AC3 " of AC3
01100
01200 ⊗
01300 HERE(PMAP)
01400 PUSHJ P,SAVE
01500 MOVE LPSA,X44
01600 MOVE 1,-3(P) ;FILEPAGE
01700 MOVE 2,-2(P) ;XWD FORK,PAGE
01800 MOVE 3,-1(P) ;ACCESS BITS
01900 JSYS PMAP
02000 JRST RESTR
02100 ENDCOM(PAGES)
00100 IMSSS,<
00200 COMPIL(TT2,<PBTIN,INTTY>
00300 ,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW>
00400 ,<TT2 -- IMSSS TTY ROUTINES>)
00500
00600 DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
00700 DESR
00800 Executes the PBTIN jsys, with timing of SECONDS.
00900 ⊗
01000 HERE(PBTIN)
01100 SETZM CTLOSW ;PROGRAM REQUESTS INPUT
01200 MOVE 1,-1(P) ;TIME IN SECONDS
01300 JSYS PBTIN
01400 SUB P,X22
01500 JRST @2(P)
01600
00100 DSCR STRING SIMPLE PROCEDURE INTTY;
00200 Using the PSTIN jsys, accepts as many as 200 characters from
00300 the user's Teletype, with the standard system breakcharacters. The
00400 breakcharacter itself is removed from the string, and
00500 no timing is available. For fancier calls, see PSTIN routine.
00600 ⊗
00700
00800 HERE(INTTY)
00900 PUSH P,1
01000 PUSH P,2
01100 PUSH P,3
01200 SETZB 3,CTLOSW ;PROGRAM REQUESTS INPUT
01300 MOVEI 2,=200 ;DEFAULT LENGTH
01400 INTT2: PUSH P,2 ;LENGTH
01500 PUSHJ P,ZSETST ;GET BP IN 1
01600 JSYS PSTIN
01700 CAIL 2,=200 ;DID WE GET 200 CHARS?
01800 JRST [SETOM .SKIP.
01900 JRST INTT1]
02000 LDB 3,1 ;GET THE LAST CHAR
02100 MOVEM 3,.SKIP. ;AND SAVE IT
02200 SOJ 1, ;BACK UP BYTE-POINTER (OVER LAST CHAR)
02300 IBP 1
02400 IBP 1
02500 IBP 1
02600 IBP 1
02700 INTT1: PUSH P,[=200]
02800 PUSH P,1
02900 PUSHJ P,ZADJST ;GET STRING ON STACK
03000 POP P,3
03100 POP P,2
03200 POP P,1
03300 POPJ P, ;RETURN
03400
03500
03600 ENDCOM(TT2)
03700 >;IMSSS
03800
00100 NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
00200 ;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
00300
00400 COMPIL(TT2,<INTTY>
00500 ,<X11,.SKIP.,ZSETST,ZADJST,CTLOSW,SAVE,RESTR>
00600 ,<TT2 -- INTTY FOR TENEX STYLE INPUT>)
00700 DSCR INTTY
00800
00900
01000 ⊗;
01100 HERE(INTTY)
01200 BEGIN INTTY
01300 ORIGCNT←←=200
01400 ;AC USES A,B,C JSYS TEMPORARIES
01500 ; D BYTEPOINTER
01600 ; E COUNT, INITIALLY 0
01700 ; Q1 (=6) ORIGINAL BP
01800
01900
02000 PUSHJ P,SAVE
02100 SETZM CTLOSW
02200 MOVEI A,101
02300 JSYS RFMOD
02400 PUSH P,B ;SAVE THE TTY MODE
02500 TRO B,170000 ;WAKEUP ON EVERYTHING
02600 JSYS SFMOD
02700
02800 PUSH P,[ORIGCNT] ;
02900 PUSHJ P,ZSETST ;GET A GOOD BP IN A
03000 MOVE Q1,A
03100
03200
03300
03400 RESTRT: MOVE D,Q1 ;GET THE ORIGINAL BP
03500 SETZ E, ;ZERO THE COUNT
03600 INLUP: CAIL E,ORIGCNT
03700 JRST CNTEXH ;COUNT EXHAUSTED
03800 JSYS PBIN ;GET A CHAR
03900 CAIE A,37 ;EOL?
04000 CAIN A,33 ;ESCAPE?
04100 JRST DONE
04200 CAIE A,32 ;CTRL-Z
04300 CAIN A,7 ;CTRL-G
04400 JRST DONE
04500 CAIE A,"R"-100 ;CTRL-R FOR REPEAT
04600 JRST NOCTR
04700 HRROI A,[ASCIZ/
04800 /]
04900 JSYS PSOUT
05000 JUMPE E,INLUP
05100 MOVEI A,101
05200 MOVE B,Q1 ;ORIG BP
05300 MOVN C,E ;COUNT THUS FAR
05400 JSYS SOUT
05500 JRST INLUP ;AND CONTINUE
05600 NOCTR: CAIE A,"X"-100 ;CONTROL-X FOR DELETE LINE
05700 JRST NOCTX
05800 DOCTX: HRROI A,[ASCIZ/
05900 /]
06000 JSYS PSOUT
06100 JRST RESTRT ;AND START ALL OVER
06200 NOCTX: CAIE A,177 ;RUBOUT OR
06300 CAIN A,"A"-100 ;CONTROL-A
06400 JRST .+2
06500 JRST NOCTA
06600 JUMPLE E,DOCTX ;IF NO CHARS THEN DO A CONTROL-X
06700 MOVEI A,"\"
06800 JSYS PBOUT
06900 LDB A,D ;LAST CHAR
07000 JSYS PBOUT
07100 MOVE A,D
07200 JSYS BKJFN
07300 JFCL
07400 MOVEM A,D ;BACK UP BP
07500 SOJA E,INLUP ;SUBTRACT 1 AND CONTINUE
07600 NOCTA: IDPB A,D
07700 AOJA E,INLUP ;ONE MORE CHAR
07800
07900 CNTEXH: SETO A, ;INDICATE NO COUNT
08000 DONE: MOVEM A,.SKIP. ;BREAK CHAR, -1 FOR EXHAUSTED
08100 PUSH P,[ORIGCNT]
08200 PUSH P,D ;NEW BP
08300 PUSHJ P,ZADJST ;FIX UP STRING SPACE, PUT STRING ON STACK
08400 MOVEI A,101
08500 POP P,B ;MODE SETTING
08600 JSYS SFMOD ;RESET
08700 MOVE LPSA,X11
08800 JRST RESTR ;AND RETURN
08900
09000 BEND INTTY
09100 ENDCOM(TT2)
09200 >;NOIMSSS
00100 COMMENT ⊗ TTY FUNCTIONS ⊗
00200
00300
00400 DSCR TTY FUNCTIONS
00500 CAL SAIL
00600 ⊗
00700
00800 Comment ⊗
00900 INTEGER PROCEDURE INCHRW;
01000 RETURN A CHAR FROM PBIN
01100
01200 INTEGER PROCEDURE INCHRS;
01300 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (SIBE FOLLOWED BY PBIN)
01400
01500 STRING PROCEDURE INCHWL;
01600 WAIT FOR A LINE, THEN RETURN IT (PBINs, LINE EDITING)
01700
01800 STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
01900 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
02000 STR←LINE (SIBE, FOLLOWED BY PBINs)
02100
02200 STRING PROCEDURE INSTR(INTEGER BRCHAR);
02300 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (PBINs)
02400
02500 STRING PROCEDURE INSTRL(INTEGER BRCHAR);
02600 WAIT FOR ONE LINE, THEN DO INSTR (PBINs WITH EDITING)
02700
02800 STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
02900 FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
03000 STR←INSTR(BRCHAR)
03100
03200
03300 PROCEDURE OUTCHR(INTEGER CHAR);
03400 OUTPUT CHAR (PBOUT)
03500
03600 PROCEDURE OUTSTR(STRING STR);
03700 OUTPUT STR (SOUT)
03800
03900
04000 PROCEDURE CLRBUF;
04100 CLEARS INPUT BUFFER (CFIBF)
04200
04300 TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
04400 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
04500 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
04600 TTYINL DOES A WAIT FOR LINE FIRST.
04700 FULL BREAKSET CAPABILITIES EXCEPT FOR
04800 "R" MODE (AND OF COURSE, LINE NUM. STUFF)
04900
05000 TITLE TTYUUO
05100 ⊗
05200
05300 COMPIL(TTY,<PBIN,PBOUT,PSOUT,INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL,TTYUP
05400 >
05500 ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,CTLOSW>
05600 ,<TELETYPE FUNCTIONS>)
05700 ;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
05800 ; .SKIP. EXTERNAL ABOVE
05900 ;;#GF#
06000
00100 HERE(PBIN)
00200 HERE (INCHRW)
00300 SETZM CTLOSW ;INPUT REQUESTED
00400 INCHR1: JSYS PBIN
00500 POPJ P,
00600
00700 HERE (INCHRS)
00800 SETZM CTLOSW ;INPUT REQUESTED
00900 MOVEI 1,100
01000 JSYS SIBE
01100 JRST INCHR1
01200 SETO 1, ;RETURN -1
01300 POPJ P,
01400
01500 HERE(PBOUT)
01600 HERE (OUTCHR)
01700 SKIPE CTLOSW ;DOING OUTPUT?
01800 JRST OUTCRE ;NO
01900 EXCH 1,-1(P) ;GET PARAMETER, SAVING AC 1
02000 JSYS PBOUT ;OUTPUT CHAR
02100 EXCH 1,-1(P) ;GET BACK 1
02200 OUTCRE: SUB P,X22
02300 JRST @2(P) ;RETURN
02400
02500
02600 HERE(PSOUT)
02700 HERE (OUTSTR)
02800 SKIPE CTLOSW ;DOING OUTPUT?
02900 JRST [SUB SP,X22
03000 POPJ P,
03100 ]
03200 EXCH 2,(SP) ;BP WORD
03300 EXCH 3,-1(SP) ;LENGTH WORD
03400 PUSH P,1 ;ALSO NEED 1
03500 HRRZ 3,3 ;COUNT
03600 JUMPE 3,NULSTR ;DONT SEND EMPTY STR
03700 MOVEI 1,101 ;TERMINAL OUTPUT
03800 MOVN 3,3
03900 JSYS SOUT
04000 NULSTR: POP P,1
04100 POP SP,2
04200 POP SP,3 ;ADJUSTS STACK AUTOMATICALLY
04300 POPJ P, ;RETURN
04400
04500 ;REDSTR (0) MARKS CTLOSW THAT INPUT WAS REQUESTED
04600 ;(1) PREPARES TO MAKE A STRING OF 200 CHARS,
04700 ;(2) ZEROS C FOR COUNT
04800 ;(3) SETS UP D WITH THE ORIGINAL BYTE-POINTER
04900
05000 REDSTR: SETZM CTLOSW ;INPUT REQUESTED
05100 SKIPE SGLIGN(USER)
05200 PUSHJ P,INSET
05300 MOVEI A,=200
05400 ADDM A,REMCHR(USER)
05500 SKIPLE REMCHR(USER)
05600 PUSHJ P,STRNGC
05700 SETZ C, ;COUNT HERE
05800 MOVE D,TOPBYTE(USER) ;ORIGINAL BYTE-POINTER, IF NEEDED
05900 PUSH SP,[0] ;NULL STRING IF NOTHING DONE
06000 PUSH SP,TOPBYTE(USER)
06100 POPJ P,
06200
06300 FINSTR: MOVEI A,=200
06400 SUB A,C ;NUMBER USED
06500 ADDM A,REMCHR(USER)
06600 HRROM C,-1(SP) ;STRING COUNT WORD
06700 MOVEM D,TOPBYTE(USER) ;NEW TOPBYTE
06800 JRST RESTR
06900
07000 ;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
07100 ;AC 3 HAS THE COUNT, D THE BYTE-POINTER
07200 EDICHR:
07300 JSYS PBIN ;GET A CHARACTER
07400 CAIN 1,DELLINE ;DELETE LINE CHAR
07500 JRST CTRLU
07600 CAIN 1,RUBCHAR ;RUBOUT?
07700 JRST RUBOUT
07800 CAIN 1,37 ;PHONEY TENEX EOL?
07900 MOVEI 1,12
08000 CAIN 1,33 ;PHONEY TENEX ALTMODE?
08100 MOVEI 1,ALTMODE ;DEC ALTMODE
08200 POPJ P, ;GOOD CHAR FOR USER
08300
08400 CTRLU:
08500 ;AC 1 IS FREE
08600 HRROI 1,[BYTE (7) 7,15,12,0,0]
08700 JSYS PSOUT
08800 JUMPE C,EDICHR ;IF NO CHARS THEN DO NOTHING
08900 SETZ C,
09000 MOVE D,TOPBYTE(USER)
09100 JRST EDICHR
09200
09300 RUBOUT: JUMPE C,CTRLU ;IF NO CHARS THEN DO CTRLU
09400 ;AC 1 IS AVAILABLE
09500 IMSSS<
09600 MOVEI 1,101 ;PRIMARY OUTPUT
09700 JSYS DELCH
09800 JFCL
09900 JRST DLTED ;DISPLAY -- LINE EMPTY
10000 JRST DLTED ;DISPLAY -- DELETE DONE
10100 >;IMSSS
10200 MOVEI 1,"\"
10300 JSYS PBOUT
10400 LDB 1,D ;GET LAST CHAR
10500 JSYS PBOUT ;AND SEND IT
10600 DLTED:
10700 SOJ D, ;BACK UP BP TO LAST CHAR
10800 IBP D
10900 IBP D
11000 IBP D
11100 IBP D
11200 SOJA C,EDICHR ;AND GET ANOTHER CHAR
11300
11400 HERE(INSTRL)
11500 HERE (INSTR)
11600 PUSHJ P,SAVE
11700 PUSHJ P,REDSTR
11800 MOVE B,-1(P) ;BREAK CHAR
11900 MOVE LPSA,X22 ;# TO REMOVE
12000
12100 INS1: CAIL C,=200 ;COUNT EXHAUSTED?
12200 JRST FINSTR ;YES
12300 INS2: PUSHJ P,EDICHR ;GET A CHAR IN 1, USING EDITING
12400 CAMN 1,B ;BREAK?
12500 JRST FINSTR ; YES, ALL DONE
12600 IDPB 1,D ;PUT IT AWAY AND
12700 AOJA C,INS1
12800
12900 HERE (INCHWL) PUSHJ P,SAVE
13000 PUSHJ P,REDSTR
13100 MOVE LPSA,X11
13200
13300 INS3: CAIL C,=200 ;COUNT EXHAUSTED?
13400 JRST DNSTR1 ;YES
13500 PUSHJ P,EDICHR ;GET A CHAR
13600 CAIE 1,ALTMODE
13700 CAIN 1,12
13800 JRST DNSTR
13900 CAIN 1,15 ;CR?
14000 JRST INS3 ;IGNORE
14100 IDPB 1,D ;PUT IT AWAY AND
14200 AOJA C,INS3 ;NEXT CHARACTER
14300
14400 DNSTR: MOVEM 1,.SKIP. ;SET BREAK CHAR
14500 JRST FINSTR
14600 DNSTR1: SETOM .SKIP. ;INDICATE COUNT EXHAUSTED
14700 JRST FINSTR
14800
14900
15000 HERE (INCHSL) PUSHJ P,SAVE
15100 MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
15200 PUSHJ P,REDSTR
15300 SETOM @-1(P) ;ASSUME FAILED
15400 MOVEI 1,100 ;PRIMARY INPUT
15500 JSYS SIBE ;CHARACTERS WAITING?
15600 SKIPA ;YES
15700 JRST FINSTR ;NO, FIX UP AND RETURN
15800 SETZM @-1(P)
15900 JRST INS3 ;AND USE INCHWL'S LOOP
16000
16100
16200 HERE(INSTRS)
16300 PUSHJ P,SAVE
16400 MOVE LPSA,X33
16500 PUSHJ P,REDSTR
16600 SETOM @-2(P) ;ASSUME FAILED
16700 MOVEI 1,100 ;RIMARY INPUT
16800 JSYS SIBE ;CHARACTERS WAITING
16900 SKIPA ;YES
17000 JRST FINSTR ;NO, FIX UP AND RETURN
17100 SETZM @-2(P) ;INDICATE SUCCESS
17200 MOVE B,-1(P) ;GET BREAK CHARACTER
17300 JRST INS2
17400
17500 HERE (CLRBUF)
17600 PUSH P,1
17700 MOVEI 1,100 ;PRIMARY INPUT
17800 JSYS CFIBF ;CLEAR BUFFER
17900 POP P,1
18000 POPJ P,
18100
18200 HERE (TTYINS) PUSHJ P,SAVE
18300 PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
18400 MOVE LPSA,X33
18500 SETOM @-1(P) ;ASSUME NO CHARS
18600 MOVEI 1,100 ;PRIMARY INPUT
18700 JSYS SIBE ;CHARS WAITING?
18800 SKIPA ;YES
18900 JRST FINSTR ;NONE WAITING
19000 JRST TYIN1 ;GO AHEAD
19100
19200
19300 HERE(TTYINL)
19400 HERE (TTYIN) PUSHJ P,SAVE
19500 TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
19600 MOVE LPSA,X33 ;PREPARE TO RETURN
19700 TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
19800 MOVE X,-2(P) ;TABLE #
19900 MOVEI TEMP,-1 ;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
20000 PUSHJ P,BKTCHK ;CHECK TABLE #
20100 JRST FINSTR ;ERROR
20200 MOVE FF,BRKMSK(CHNL) ;BITS FOR THIS TABLE
20300 ADD CHNL,CDB ;RELOCATE RANGE 1 TO 18
20400 MOVEI Z,1 ;FOR TESTING LINE NUMBERS
20500 SKIPN LINTBL(CHNL) ;DON'T LET TEST SUCCEED IF
20600 MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
20700 MOVE Y,CDB
20800 ADD Y,[XWD 1,BRKTBL] ;BRKTBL+RLC(CDB)
20900 TTYN: CAIL C,=200 ;COUNT EXCEEDED?
21000 JRST FINSTR ;YES
21100 PUSHJ P,EDICHR ;GET A CHAR
21200 TTYN1: TDNE CHNL,@Y ;BREAK OR OMIT?
21300 JRST TTYSPC ; YES, FIND OUT WHICH
21400 TTYC: IDPB 1,D ;PUT IT AWAY
21500 AOJA C,TTYN ;COUNT AND CONTINUE
21600 JRST FINSTR ;DONE
21700 TTYSPC: HLLZ TEMP,@Y ;WHICH?
21800 TDNN TEMP,CHNL
21900 JRST TTYN ;OMIT
22000 MOVEM 1,@-1(P)
22100 SKIPN Y,DSPTBL(CHNL) ;WHAT TO DO WITH IT
22200 JRST FINSTR ;DONE, NO SAVE
22300 JUMPL Y,TTYAPP ;APPEND
22400 PUSH P,1 ;SAVE
22500 MOVEI 1,100 ;PRIMARY INPUT
22600 JSYS BKJFN
22700 ERR <CAN'T RETAIN BREAK CHAR FROM TTYIN>,1
22800 POP P,1
22900 JRST FINSTR ;AND RETURN
23000 TTYAPP: IDPB 1,D ;COUNT THE BREAK CHAR
23100 ADDI C,1 ;ONE MORE HAPPY CHAR
23200 JRST FINSTR
23300
23400
23500 DSCR INTEGER PROCEDURE TTYUP(INTEGER NEWVALUE)
23600
23700 Using the RFMOD and SFMOD jsyses, sets lower-to-upper
23800 case conversion to NEWVALUE, returning the oldvalue. Tests
23900 and modifies bit 31 of the RFMOD word for the primary input
24000 file.
24100 ⊗;
24200 HERE(TTYUP)
24300 PUSHJ P,SAVE
24400 MOVE LPSA,X22 ;SET FOR RETURN
24500 MOVEI A,101 ;PRIMARY INPUT FILE
24600 JSYS RFMOD ;GET THE CURRENT SETTINGS
24700 SETZ C, ;ASSUME NOT CURRENTLY SET
24800 TRNE B,1B31 ;IS IT SET?
24900 SETO C, ;IT WAS
25000 MOVEM C,RACS+A(USER)
25100 MOVE C,[TRO B,1B31] ;ASSUME WE WANT TO SET UP
25200 SKIPN -1(P) ;DID WE REALLY?
25300 MOVE C,[TRZ B,1B31] ;NO, DONT
25400 XCT C
25500 JSYS STPAR
25600 JRST RESTR ;AND RETURN
25700
25800
25900 ENDCOM(TTY)
26000 COMPIL(PTY)
26100 ENDCOM(PTY)
26200
26300 COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
00100 COMMENT ⊗Filnam ⊗
00200
00300 DSCR FILNAM
00400 CAL PUSHJ
00500 PAR file name string on SP stack
00600 of form FILENAME<.EXT><[PROJ,PROG]>
00700 RES FNAME(USER) : SIXBIT /filename/
00800 EXT(USER): SIXBIT /extension,,0/
00900 0
01000 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
01100 SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
01200 ⊗
01300
01400 ↑↑FILNAM:
01500 SUB SP,X22 ;ADJUST STACK
01600 FOR II←1,3 <
01700 SETZM FNAME+II(USER)>
01800 MOVEI X,FNAME(USER) ;WHERE TO PUT IT
01900 PUSHJ P,FLSCAN ;GET FILE NAME
02000 JUMPE Y,FLDUN ;FILE NAME ONLY
02100 CAIE Y,"." ;EXTENSION?
02200 JRST FLEXT ;NO, CHECK PPN
02300 MOVEI X,FNAME+1(USER)
02400 PUSHJ P,FLSCAN
02500 FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
02600 CAIE Y,"["
02700 JRST FLERR ;INVALID CHARACTER
02800 PUSHJ P,[
02900
03000 RJUST: SETZM PROJ(USER)
03100 MOVEI X,PROJ(USER)
03200 PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
03300 IFN SIXSW,<
03400 MOVE X,PROJ(USER)
03500 IMULI D,-6 ;SHIFT FACTOR
03600 LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
03700 >;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
03800
03900 IFE SIXSW,<
04000 MOVEI X,0
04100 ;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
04200 MOVE D,PROJ(USER) ;WAS A HLLZ
04300 ;;
04400 FBACK: MOVEI C,0
04500 LSHC C,6 ;GET A SIXBIT CHAR
04600 CAIL C,'0'
04700 CAILE C,'7'
04800 JRST FLERR ;INVALID OCTAL
04900 LSH X,3
05000 IORI X,-'0'(C)
05100 JUMPN D,FBACK
05200 >;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
05300 FPOP: POPJ P,]
05400
05500 HRLZM X,FNAME+3(USER)
05600 CAIE Y,","
05700 JRST FLERR ;INVALID CHAR
05800 PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
05900 HRRM X,FNAME+3(USER)
06000 CAIN Y,"]"
06100 FLDUN: AOS (P) ;SUCCESSFUL
06200 FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
06300
06400 ENDCOM(FIL)
06500 COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
00100 COMMENT ⊗Flscan ⊗
00200
00300 DSCR FLSCAN
00400 CAL PUSHJ
00500 PAR X -- addr of destination SIXBIT
00600 1(SP), 2(SP) -- input string
00700 RES sixbit for next filename, etc in word addressed by X
00800 break (punctuation) char in Y (0 if string exhausted)
00900 D,X, input string adjusted
01000 SID only those AC changes listed above (Y, for instance)
01100 ⊗
01200
01300 ↑↑FLSCAN:
01400 HRRZS 1(SP) ;WANT ONLY LENGTH PART
01500 MOVEI D,6 ;MAX NUMBER PICKED UP
01600 SETZM (X) ;ZERO DESTINATION
01700 HRLI X,440600 ;BYTE POINTER NOW
01800 FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
01900 SOSGE 1(SP) ;TEST 0-LENGTH STRING
02000 POPJ P,
02100 ILDB Y,2(SP) ;GET BYTE
02200 CAIE Y,"." ;CHECK VALID BREAK CHAR
02300 CAIN Y,"["
02400 POPJ P,
02500 CAIE Y,"]"
02600 CAIN Y,","
02700 POPJ P,
02800 JUMPE D,FLN1 ;NEED NO MORE CHARS
02900 TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
03000 TRZA Y,40 ; TO CONVERT TO SIXBIT
03100 TRO Y,40 ; (NO CHECKING)
03200 IDPB Y,X ;PUT IT AWAY
03300 SOJA D,FLN1 ;CONTINUE
03400
03500 ENDCOM(FLS)
00100 COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
00200 ,<CSERR, LPRYER -- SUPPORT ROUTINES>)
00300 HERE(CSERR) MOVE USER,GOGTAB
00400 POP P,UUO1(USER) ;STANDARD PLACE
00500 ERR <CASE INDEX OVERFLOW, VALUE IS >,13
00600 JRST @UUO1(USER) ;RETURN OK
00700
00800 HERE (LPRYER) ERR <DATUM OF ARRAY NOT THERE>,1
00900 POPJ P,
01000
01100 ENDCOM(CAS)
01200
01300
01400 IFN ALWAYS, <BEND IOSER>
01500 DSCR BEND IOSER ⊗
01600 >;TENX
00100
00200
00300
00400
00500
00600
00700
00100
00200
00300
00400
00500
00600
00700